I get several excel files each month that I need to extract data from and put into Access:
Source folder = S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Raw
Each worksheet will have different size data ranges, but all data begins in Cell A19
Column J should get the Run Date from the value in C10 of the source sheet.
The excel files each contain one worksheet called "RPT_VALFLIST.RPT"
The first 18 rows of data in the sheet are standard header info and column headers.
I do want to capture the Run Date which is in cell C10 and populate a new field with the date from each sheet (This will let me know the age of the data).
This is what I have. It mostly works, except that the Run Date value comes in as 280.
Also, some programming explainations would be helpful. I 'adapted' this from a previous solution.
If someone could add comments explaining what the steps do it would sure help my learning curve.
I'm assigning extra points to compensate for the extra commenting requested.
I will have other excel files to import that will be similar, but the ranges of data will vary and not every field in a row will have data.
When I read multiple files, what ensures that the data is appended at the end of the current last row?
How do I account for the dynamic ranges in the source data?
Thanks in advance for your help.
Public Sub ExcelScan()
Dim xlApp As New Excel.Application
Dim xlWB As Excel.Workbook, xlWB2 As Excel.Workbook
Dim xlWS As Excel.Worksheet, xlWS2 As Excel.Worksheet
Dim xlRng As Excel.Range, xlRng1 As Excel.Range, xlRng2 As Excel.Range
Dim fso As New Scripting.FileSystemObject
Dim fl As File
Dim fls As Files
Dim fol As Folder
Dim q As Integer, v As Integer, w As Integer, x As Integer, y As Integer, z As Integer
'Source of raw NFTS Query output files xls
Const Filepath = "S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Raw\"
'Location to save formatted NFTS data for importing to Access Database
Const Path2 = "S:\NYC Reports\- Working Reports Folder\Inventory SWIP\Data_from_NFTS\Ready\"
xlApp.Visible = False
Set xlWB2 = xlApp.Workbooks.Add
Set xlWS2 = xlWB2.Worksheets.Add
'Range for the column headers in the new sheet
Set xlRng1 = xlWS2.Range("A1", "J1")
'Need help here, I don't know how many rows I will end up with.
Set xlRng2 = xlWS2.Range("A2", "J1000") 'Need help here - destination range for the data to be copied
Set fol = fso.GetFolder(Filepath)
Set fls = fol.Files
'Set the Column Header Values in Columns A thu J
' reference format cells(row,column)
xlRng1.Cells(1, 1) = "SEC_CODE"
xlRng1.Cells(1, 2) = "DESC"
xlRng1.Cells(1, 3) = "RP_CODE"
xlRng1.Cells(1, 4) = "RP_DESC"
xlRng1.Cells(1, 5) = "FILE_NUMBER"
xlRng1.Cells(1, 6) = "RPC_ASSIGNED"
xlRng1.Cells(1, 7) = "LAST_ACTIVITY"
xlRng1.Cells(1, 8) = "LAST_AUDIT"
xlRng1.Cells(1, 9) = "STATUS"
xlRng1.Cells(1, 10) = "NFTS_DATE"
v = 1
For Each fl In fls
Set xlWB = xlApp.Workbooks.Open(fl, False, False)
Set xlWS = xlWB.Worksheets("RPT_VALFLIST.RPT")
'Count the number of rows in sheet
q = xlWS.Cells.Find(What:="*", LookIn:=-4163, LookAt:=1, SearchOrder:=1, SearchDirection:=2).Row
'I was going to use the value of q to set my range limit, but wasn't
' Sure how to do this, I got errors no matter what I tried.
'Does my current setting limit me to 10000 rows of data?
Set xlRng = xlWS.Range("A19", "J10000")
For z = 1 To q Step 1
If xlRng.Cells(z, 1) <> "" Then
xlRng2.Cells(v, 1) = xlRng.Cells(z, 1)
xlRng2.Cells(v, 2) = xlRng.Cells(z, 2).Value
xlRng2.Cells(v, 3) = xlRng.Cells(z, 3).Value
xlRng2.Cells(v, 4) = xlRng.Cells(z, 4).Value
xlRng2.Cells(v, 5) = xlRng.Cells(z, 5).Value
xlRng2.Cells(v, 6) = xlRng.Cells(z, 6).Value
xlRng2.Cells(v, 7) = xlRng.Cells(z, 7).Value
xlRng2.Cells(v, 8) = xlRng.Cells(z, 8).Value
xlRng2.Cells(v, 9) = xlRng.Cells(z, 9).Value
xlRng2.Cells(v, 10) = xlRng.Cells(10, 3).Value
v = v + 1
' go through each file, copy the data from A19:J___ (to the last row of data)
' Need to set Column J = to the value found on the source worksheet in cell = C12 (Date mm/dd/yyyy)
' Repeat this for each workbook in the folder - copying the data and appending it at the bottom of the
' destination sheet
Set xlRng = Nothing
Set xlWS = Nothing
xlApp.DisplayAlerts = False
xlWB2.SaveAs Path2 & "NFTS_Temp.xls"
xlApp.DisplayAlerts = True
Set xlRng = Nothing
Set xlRng2 = Nothing
Set xlWS2 = Nothing
Set xlWB = Nothing
Set xlWB2 = Nothing
Set xlApp = Nothing
MsgBox "File created successfully: " & Path2 & "NFTS_Temp.xls", vbOKOnly, "File created"