Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
This 3-part script collects data from CSV files, stores it in a master file and moves the already-imported CSVs into a "processed" folder
Option Explicit
Public Sub ImportAllDataFiles()
Dim strFile As String
Dim wbk As Workbook
Dim wks As Worksheet, wksMaster As Worksheet
Dim lngLastMasterRow As Long, lngFirstMasterRow As Long, _
lngLastDataRow As Long, lngLastDataCol As Long, lngIdx As Long, _
lngTimeZoneCol As Long, lngDateCol As Long
Dim rngTimeZoneCol As Range, rngDateCol As Range, _
rngSource As Range, rngDestination As Range
Dim varTimeZoneCol As Variant, varDateCol As Variant
Dim strTimeZone As String
Dim datDate As Date
'Initial setup, where we assign the master worksheet and establish
'the time zone column and date column
Set wksMaster = ThisWorkbook.Worksheets("master")
lngTimeZoneCol = 18
lngDateCol = 19
'First we establish the files we want to add to the master file
strFile = Dir(ThisWorkbook.Path & "\*.csv")
'Now we loop through those files -- in this case, all the CSVs
While Len(strFile) > 0
'Here we establish the limits of our master data sheet
'(so we know where to paste our source data from the CSV
With wksMaster
lngLastMasterRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'The destination range is the first row underneath the
'existing block of data
Set rngDestination = .Cells(lngLastMasterRow + 1, 1)
End With
'Now we open the next CSV, setting variables for easy reference
Set wbk = Workbooks.Open(ThisWorkbook.Path & "\" & strFile)
Set wks = wbk.ActiveSheet
'Next we need to identify the data range to copy to our master file
With wks
lngLastDataRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lngLastDataCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Cool! Now we just need to grab the block of data, not the headers
Set rngSource = .Range(.Cells(4, 1), _
.Cells(lngLastDataRow, lngLastDataCol))
End With
'Since our Source and Destination Ranges are now stored in variables,
'we can do a one-line copy and paste!
rngSource.Copy Destination:=rngDestination
'But do not forget, we want to copy the Date and Time Zone info too!
With wksMaster
'Here we recalibrate our data range (since new data has been added)
lngFirstMasterRow = lngLastMasterRow
lngLastMasterRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'The time zone data will go one column past the recently-pasted
'data block
Set rngTimeZoneCol = .Range(.Cells(lngFirstMasterRow + 1, _
lngTimeZoneCol), _
.Cells(lngLastMasterRow, _
lngTimeZoneCol))
'The date data will go one column past the time zone data
Set rngDateCol = .Range(.Cells(lngFirstMasterRow + 1, _
lngDateCol), _
.Cells(lngLastMasterRow, _
lngDateCol))
'Instead of doing lots of sheet writing, we will use
'variant arrays for maximum speed
varTimeZoneCol = rngTimeZoneCol
varDateCol = rngDateCol
'Grab the time zone and date from the data sheet
strTimeZone = CStr(wks.Cells(2, 2))
datDate = CDate(wks.Cells(1, 2))
'We populate the variant arrays with our time zone and date data
For lngIdx = 1 To UBound(varTimeZoneCol)
varTimeZoneCol(lngIdx, 1) = strTimeZone
varDateCol(lngIdx, 1) = datDate
Next lngIdx
'Write the variant array results to the time zone and date ranges
rngTimeZoneCol = varTimeZoneCol
rngDateCol = varDateCol
End With
'Finally, we close the data file and increment to the
'next CSV file in the folder
wbk.Close SaveChanges:=False
strFile = Dir
Wend
'Let the user know our script is complete!
ThisWorkbook.Save
MsgBox "Data has been merged into the master sheet and saved!"
End Sub
Option Explicit
Public Sub ImportDataThenMoveFiles()
Call ImportAllDataFiles '<~ we write this subroutine in Part 2
Call MoveImportedDataFiles '<~ we write this subroutine in Part 3
End Sub
Option Explicit
Public Sub MoveImportedDataFiles()
Dim strFile As String, strSourceFile As String, _
strDestinationFile As String
'We start by identifying the the files that need to be moved into
'the "processed" folder
strFile = Dir(ThisWorkbook.Path & "\*.csv")
'Now we begin looping through those files -- all the CSVs in this folder
While Len(strFile) > 0
'Here we establish the full file path
strSourceFile = ThisWorkbook.Path & "\" & strFile
'This is what we want the CSV to end up as
strDestinationFile = ThisWorkbook.Path & "\processed\" & strFile
'One-line rename, easy cheesy!
Name strSourceFile As strDestinationFile
'Increment to the next CSV file
strFile = Dir
Wend
'Let the user know that all CSV files have been moved
MsgBox "CSV files moved into the 'processed' folder!"
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.