Automate Edits to xls Spreadsheet

D

dj59

Registered User.
Local time
Today, 13:40
Joined
Jul 27, 2012
Messages
70
We receive multiple spreadsheets daily. Each one of these spreadsheets needs to be manually edited before being imported into MS Access. I am looking for a way use VBA code to automate the manual edit process. The following are the edits that need to happen to each of the spreadsheets.
·[FONT=&quot] [/FONT]Omit Extra Rows and Columns – there are many blank cells to the right and bottom of the actual needed data.
·[FONT=&quot] [/FONT]Make sure data sheet is named “Data”
·[FONT=&quot] [/FONT]Insert first column named PIN
·[FONT=&quot] [/FONT]Insert PIN number in first column (ctrl D)- This would need to be user input.
·[FONT=&quot] [/FONT]Change second column name to “EventID”
·[FONT=&quot] [/FONT]Change third column name to “TimeStamp”
·[FONT=&quot] [/FONT]Format TimeStamp column as Date / Type mm/dd/yyyy hh:mm:ss AM/PM


[FONT=&quot]I'm not sure if any of this is possible, but it would sure save us a lot of time. We are not able to require the users to send the data with a template that has the above format.
Thanks.
[/FONT]
 
All of this is possible.

Omiting rows/columns can be done with rows (columns) . select and Selection.Delete Shift:=xlUp

Naming a sheet is simply activesheet.name = "Data"

Insert a column with Columns .Select and Selection.Insert Shift:=xlToRight

Naming a cell is cells(r,c)= xyz

Format is done with Selection.NumberFormat = "mm/dd/yyyy hh:mm:ss AM/PM"

The best way to start is to record a macro doing the things you want to do, as you manually do them. Do each step in a seperate macro. After open the VisualBasic editor ALT+F11 and look at each macro to see how it does what it does.

The first item, Omit extra rows/columns would need to be adapted to allow for different number of rows/columns each time.

Get these macros and come back with them and i or someone will be able to assist adapting them to your needs.
 
The macros are below:

Code: 
Sub AddColumn1()
'
' AddColumn1 Macro
'
'
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "PIN"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1072"    'This needs to be user input.
    Range("A2:A1378").Select
    Range("A1378").Activate
    Selection.FillDown
    Range("B1").Select
End Sub
Sub ChangeNameOfcolumn2()
'
' ChangeNameOfcolumn2 Macro
'
'
    ActiveCell.FormulaR1C1 = "EventID"
    Range("C1").Select
End Sub
Sub ChangeNameOfcolumn3()
'
' ChangeNameOfcolumn3 Macro
'
'
    ActiveCell.FormulaR1C1 = "TimeStamp"
    Range("C2").Select
End Sub
Sub ChangeFormatOfColumn3()
'
' ChangeFormatOfColumn3 Macro
'
'
    Columns("C:C").Select
    Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
End Sub
Sub CopyDataToNewSheet_OmitBlankRowsColumns()
'
' CopyDataToNewSheet_OmitBlankRowsColumns Macro
'
'
    Range("A1").Select
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 214
    ActiveWindow.ScrollRow = 320
    ActiveWindow.ScrollRow = 426
    ActiveWindow.ScrollRow = 533
    ActiveWindow.ScrollRow = 639
    ActiveWindow.ScrollRow = 745
    ActiveWindow.ScrollRow = 852
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 1171
    ActiveWindow.ScrollRow = 1490
    ActiveWindow.ScrollRow = 1596
    ActiveWindow.ScrollRow = 1809
    ActiveWindow.ScrollRow = 1915
    ActiveWindow.ScrollRow = 2021
    ActiveWindow.ScrollRow = 2128
    ActiveWindow.ScrollRow = 2340
    ActiveWindow.ScrollRow = 2553
    ActiveWindow.ScrollRow = 2659
    ActiveWindow.ScrollRow = 2766
    ActiveWindow.ScrollRow = 2872
    ActiveWindow.ScrollRow = 2978
    ActiveWindow.ScrollRow = 3085
    ActiveWindow.ScrollRow = 3191
    ActiveWindow.ScrollRow = 3297
    ActiveWindow.ScrollRow = 3403
    ActiveWindow.ScrollRow = 3510
    ActiveWindow.ScrollRow = 3616
    ActiveWindow.ScrollRow = 3829
    ActiveWindow.ScrollRow = 3935
    ActiveWindow.ScrollRow = 4041
    ActiveWindow.ScrollRow = 4148
    ActiveWindow.ScrollRow = 4041
    ActiveWindow.ScrollRow = 3935
    ActiveWindow.ScrollRow = 3829
    ActiveWindow.ScrollRow = 3722
    ActiveWindow.ScrollRow = 3616
    ActiveWindow.ScrollRow = 3510
    ActiveWindow.ScrollRow = 3297
    ActiveWindow.ScrollRow = 3191
    ActiveWindow.ScrollRow = 2978
    ActiveWindow.ScrollRow = 2766
    ActiveWindow.ScrollRow = 2553
    ActiveWindow.ScrollRow = 2234
    ActiveWindow.ScrollRow = 2128
    ActiveWindow.ScrollRow = 1915
    ActiveWindow.ScrollRow = 1809
    ActiveWindow.ScrollRow = 1702
    ActiveWindow.ScrollRow = 1596
    ActiveWindow.ScrollRow = 1490
    ActiveWindow.ScrollRow = 1383
    ActiveWindow.ScrollRow = 1277
    ActiveWindow.ScrollRow = 1171
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 1171
    ActiveWindow.ScrollRow = 1277
    ActiveWindow.ScrollRow = 1383
    ActiveWindow.ScrollRow = 1277
    ActiveWindow.ScrollRow = 1171
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 958
    ActiveWindow.ScrollRow = 852
    ActiveWindow.ScrollRow = 958
    ActiveWindow.ScrollRow = 1064
    ActiveWindow.ScrollRow = 1171
    ActiveWindow.ScrollRow = 1277
    ActiveWindow.ScrollRow = 1383
    ActiveWindow.SmallScroll Down:=-17
    Range("A1:G1378").Select
    Selection.Cut
    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("C:C").EntireColumn.AutoFit
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Sheet1"
    Sheets("Data").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Data"
    Range("C27").Select
End Sub
 
Last edited by a moderator:
Most of what you need is there; you just need to combine it in 1 piece of code and make a couple of changes. For example the ActiveWindow.ScrollRow can all be removed and Range(xx).Select then ActiveCell.FormulaR1C1 = "xyz" can be replaced with range(xx)="xyz" and to get input from the user use the InputBox method

Something like this should work.

Code: 
Sub PrepData()
Dim RwExt As Integer

RwExt = ActiveSheet.UsedRange.Rows.Count 'this counts the number of rows on the sheet

'Add new sheet, copy data and delete old sheet
Range("A1:G" & LTrim(Str(RwExt))).Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
Columns("C:C").EntireColumn.AutoFit
Sheets("Data").Select
ActiveWindow.SelectedSheets.Delete
ActiveSheet.Name = "Data"

'insert column, name, obtain user required value and fill all cells for PIN column
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1") = "PIN"
Range("A2") = InputBox("Please enter the PIN number", "PIN request")
Range("A2:A" & LTrim(Str(RwExt))).Select
Selection.FillDown

'name EventID column
Range("B1") = "EventID"

'Name TimeStamp column
Range("C1") = "TimeStamp"

'Set user defined format for TimeStamp column
Columns("C:C").Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"

'save sheet
ActiveWorkbook.SaveAs 
End Sub

Now the BIG question is where to store this code. Obviously it will not be in the spreadsheets you receive. There are a few options; Personal.xls, create a UDF or store it in another workbook that is always open.
 
Isskint, you code is a fantastic suggestion for his code improvement.

re: Now the BIG question is where to store this code.
Quote: "Each one of these spreadsheets needs to be manually edited before being imported into MS Access"
Since he Imports the Excel into Access - maybe he can select the Excel workbook from Access, set a reference to the Excel workbood to be imported, then run the code from Access. Then import the Excel data into Access as usual.
 
Isskint:
This looks excellent.
There seems to be something wrong with this line/lines of code. I’ll keep looking for what is wrong, but you may see it quicker than me.
Range("A2") = InputBox("Please enter the PIN number", "PIN request")
Range("A2:A" & LTrim(Str(RwExt))).Select Selection.FillDown

Rx:
That is great! I’ll first get the code working with one sheet, then let’s try to get it in Access to work as you suggest.

Thank you both so much.
 
Some Thoughts:
After reading this I am now wondering if it would be better to import the excel data sheet just as it is, then manipulate it once it's in Access. The way it is set up currently is manual manipulation of each data sheet, then automatic import to Access (using a button in Access) and then automatic move of the file that was loaded to a "saved" folder.
code:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblFreezer", _
"C:\Access \DataLogger\IMPORT_FreezerFiles\" & strFile, True, "Data!A1:G999999"

'Copy File from Import Foler to Save Folder, then delete it from Import Folder.
FileCopy "C:\ Access \DataLogger\IMPORT_FreezerFiles\" & strFile, "C:\ Access \DataLogger\SAVED\" & strFile
Kill "C:\ Access \DataLogger\IMPORT_FreezerFiles\" & strFile



Also, the code I have right now, from Isskint, is giving an error (runtime error 6 – overflow). I think this is because each data sheet has un-needed data in Row 65536; column Z. Although I can not be sure all the spreadsheet will have that data in the exact same cell.

What are your thoughts on the best way to proceed?
 
boblarson said:
Before you go any further, I think you both (dj59 and IssKint) should read this article:
http://www.btabdevelopment.com/ts/excelinstance
Your code is not correct and will cause problems if run more than once while the database remains open.
Click to expand...
Bob, you are quite right on this, IF the code was being run from Access. However the code i have provided was to run from Excel, so the problems you address were not a consideration to me. Rightly, however, if DJ59 decides to run it from Access, then there are many things to take into account and the code would need some changes, the binding options just one of them; a routine to identify the spreadsheet to import from would also be needed.

DJ, as Bob points out, set RwExt as a Long variable type. I (wrongly) presumed your sheets would not go down the 65K + rows.
 
1)
This code works perfect
Code: 
[B][SIZE=2]Sub PrepData()[/SIZE][/B]
[B][SIZE=2]Dim RwExt As Long[/SIZE][/B]
 
[B][SIZE=2]RwExt = ActiveSheet.UsedRange.Rows.Count 'this counts the number of rows on the sheet[/SIZE][/B]
 
[B][SIZE=2]'Add new sheet, copy data and delete old sheet[/SIZE][/B]
[B][SIZE=2]Range("A1:G" & LTrim(Str(RwExt))).Select[/SIZE][/B]
[B][SIZE=2]Selection.Cut[/SIZE][/B]
[B][SIZE=2]Sheets.Add After:=Sheets(Sheets.Count)[/SIZE][/B]
[B][SIZE=2]Columns("C:C").EntireColumn.AutoFit[/SIZE][/B]
[B][SIZE=2]Sheets("Data").Select[/SIZE][/B]
[B][SIZE=2]Sheets("Sheet1").Paste[/SIZE][/B]
[B][SIZE=2]ActiveWindow.SelectedSheets.Delete[/SIZE][/B]
[B][SIZE=2]ActiveSheet.Name = "Data"[/SIZE][/B]
 
[B][SIZE=2]'insert column, name, obtain user required value and fill all cells for PIN column[/SIZE][/B]
[B][SIZE=2]Columns("A:A").Select[/SIZE][/B]
[B][SIZE=2]Selection.Insert Shift:=xlToRight[/SIZE][/B]
[B][SIZE=2]Range("A1") = "PIN"[/SIZE][/B]
[B][SIZE=2]Range("A2") = InputBox("Please enter the PIN number", "PIN request")[/SIZE][/B]
[B][SIZE=2]Range("A2:A" & LTrim(Str(RwExt))).Select[/SIZE][/B]
[B][SIZE=2]Selection.FillDown[/SIZE][/B]
 
[B][SIZE=2]'name EventID column[/SIZE][/B]
[B][SIZE=2]Range("B1") = "EventID"[/SIZE][/B]
 
[B][SIZE=2]'Name TimeStamp column[/SIZE][/B]
[B][SIZE=2]Range("C1") = "TimeStamp"[/SIZE][/B]
 
[B][SIZE=2]'Set user defined format for TimeStamp column[/SIZE][/B]
[B][SIZE=2]Columns("C:C").Select[/SIZE][/B]
[B][SIZE=2]Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"[/SIZE][/B]
 
[B][SIZE=2]'save sheet[/SIZE][/B]
[B][SIZE=2]ActiveWorkbook.Save[/SIZE][/B]
[B][SIZE=2]End Sub[/SIZE][/B]
2)
The Access tool is already set to automatically import it from this point.
I need to find a way to store this macro so that each file is automatically updated this way before the import to Access. Would creating a schema.ini file be the answer?
 
Last edited:
I found an idea in my searches; to leave the macro code in one master spreadsheet in a specific folder, then run the code from that master spreadsheet to loop through any spreadsheets in that same folder. Below is the code, however it isn't working quite right, it does not do the "'Add new sheet, copy data and delete old sheet" portion of the macro code:

Any help is appreciated. You've all been great so far and I feel almost there.

Code: 
Sub RunCodeOnAllXLSFiles()
    Dim i As Integer
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    Dim RwExt As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
 
    On Error Resume Next
 
    Set wbCodeBook = ThisWorkbook
 
    With Application.FileSearch
        .NewSearch
        'Change path To suit
        .LookIn = " C:\\Access\DataLogger\1_PrepData"
        .FileType = msoFileTypeExcelWorkbooks
 
        If .Execute > 0 Then    'Workbooks In folder
            For i = 1 To .FoundFiles.Count    'Loop through all
                'Open Workbook x And Set a Workbook variable To it
                Set wbResults = Workbooks.Open(.FoundFiles(i))
  
RwExt = ActiveSheet.UsedRange.Rows.Count    'this counts the number of rows on the sheet
 
                'Add new sheet, copy data and delete old sheet
                Range("A1:G" & LTrim(str(RwExt))).Select
                Selection.Cut
                Sheets.Add After:=Sheets(Sheets.Count)
                Columns("C:C").EntireColumn.AutoFit
                Sheets("Data").Select
                Sheets(“Sheet1”).Paste
                ActiveWindow.SelectedSheets.Delete
                ActiveSheet.Name = "Data"
 
'insert column, name, obtain user required value and fill all cells for PIN column
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
                Range("A1") = "PIN"
                Range("A2") = InputBox("Please enter the PIN number", "PIN request")
                Range("A2:A" & LTrim(str(RwExt))).Select
                Selection.FillDown
 
                'name EventID column
                Range("B1") = "EventID"
 
                'Name TimeStamp column
                Range("C1") = "TimeStamp"
 
                'Set user defined format for TimeStamp column
                Columns("C:C").Select
                Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
 
                'save sheet
                ActiveWorkbook.Save
                ActiveWorkbook.Close

            Next i
        End If
    End With
 
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub
 
Last edited:
Please use code tags when posting code, especially large blocks of code. I've modified it for you this time.

codetag001.png
 
Thank You.
I will use the code tags in the future. Sorry 'bout that.

The above code works for one spreadsheet, but then stops it doesn't continue to loop through each sheet in the folder. Any ideas on what to change to make this happen will be appreciated.
 
I am trying a different looping code, but
The following code has 2 problems that I don't know how to fix.
1. The "Sheet1" variable is not defined.
The code works by itself, but when added to the looping piece code,
the error "variable not defined" comes up.
2. The looping process is not working right. It doesn't go to the next file in the folder.
I think excel has to completely close saving the spreadsheet and then open the next file.
Code: 
Option Explicit

Sub LoopThroughFiles()
    Dim RwExt As Long
    Dim StrFile As String
    StrFile = Dir("C:\DIANA\Access_Sudha\DataLogger\1_PrepData\*.xls")
    Do While Len(StrFile) > 0
        'Debug.Print StrFile

RwExt = ActiveSheet.UsedRange.Rows.Count    'this counts the number of rows on the sheet

'Add new sheet, copy data and delete old sheet
Range("A1:G" & LTrim(Str(RwExt))).Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
Columns("C:C").EntireColumn.AutoFit
Sheets("Data").Select
Sheets(“Sheet1”).Paste
ActiveWindow.SelectedSheets.Delete
ActiveSheet.Name = "Data"

'save sheet
ActiveWorkbook.Save
ActiveWorkbook.Close
        StrFile = Dir
    Loop
End Sub
 
Just had a few seconds to look at this, not time to test.

For ("Sheet 1")
Try (1)
Use the sheet count whenever possible.
 
Using the number for the sheets works great and solves that issue.
Now to figure out how to get it to loop through each file in the folder.. ?? ..
Thanks to all who helped me get this far!
 
I had an emergency request for an EPA project. As it turn out, I also need code for this. I am going to post a new thread right now and search for an answer.
Will post my final project.
B.T.W. tomorrow is 9/11 My squad was requested by the Govonor for a special activity. I will be on duty tomorrow, back the following day. Hopefully we get this solved today. - Look at the VBA section of this website.
 
Here is my current code.
It is working great except that it doesn't loop to the next file in the folder.
It stops after the edits are done and saved in the first data sheet.
I have this code in the first spreadsheet macro area. Should it be someplace else?

Code: 
Option Explicit

Sub LoopThroughFiles()
    Dim RwExt As Long
    Dim StrFile As String
    StrFile = Dir("C:\DIANA\Access_Sudha\DataLogger\1_PrepData\*.xls")
    Do While Len(StrFile) > 0
        'Debug.Print StrFile

RwExt = ActiveSheet.UsedRange.Rows.Count    'this counts the number of rows on the sheet

'Add new sheet, copy data and delete old sheet
Range("A1:G" & LTrim(Str(RwExt))).Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
Columns("C:C").EntireColumn.AutoFit
Sheets(2).Select
Sheets(3).Paste
ActiveWindow.SelectedSheets.Delete
ActiveSheet.Name = "Data"

'insert column, name, obtain user required value and fill all cells for PIN column
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1") = "PIN"
Range("A2") = InputBox("Please enter the PIN number", "PIN request")
Range("A2:A" & LTrim(Str(RwExt))).Select
Selection.FillDown

'name EventID column
Range("B1") = "EventID"

'Name TimeStamp column
Range("C1") = "TimeStamp"

'Set user defined format for TimeStamp column
Columns("C:C").Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"

'save sheet
ActiveWorkbook.Save
ActiveWorkbook.Close
    Loop
      StrFile = Dir

End Sub
 
Rx:
Thank you for your new thread information, however I am still not getting the end result I need. Attached is your Access db, with my code. When I get to the line:

Code: 
RwExt = ActiveSheet.UsedRange.Rows.Count    'this counts the number of rows on the sheet

There is a problem. No rows are found.
I am getting discouraged, much of this is over my head, but it sure seems like it is doable.
 

Attachments

You must log in or register to reply here.

Similar threads

R
Importing a spreadsheet to existing table where column names don't match
Replies
15
Views
1,301
gemma-the-husky
gemma-the-husky
B
Getting data from differently formatted Excel sheets to a table Form/VBA/Import question
Replies
13
Views
1,658
CJ_London
C
C
Solved problem opening a .csv file in excel - dates all messed up
2
Replies
23
Views
3,177
CJ_London
C
essaytee
How to validate 'time' value from Excel spreadsheet
2
Replies
26
Views
3,004
MarkK
MarkK
H
How to insert some data from Excel spreadsheet and the other data from Access combo boxes
Replies
4
Views
1,102
habinalshaikh
H

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom