Skip to content

Instantly share code, notes, and snippets.

@sidharthkuruvila
Created July 29, 2017 18:38
Show Gist options
  • Save sidharthkuruvila/996004fd12037532c252ecce1cba5b1e to your computer and use it in GitHub Desktop.
Save sidharthkuruvila/996004fd12037532c252ecce1cba5b1e to your computer and use it in GitHub Desktop.
vba excel macro script that aggregates data from multiple xlsx files
'vba excel macro script that aggregates data from multiple xlsx files.
'The path to the directory containing the files should be in a sheet called
'Control. And should be in Applescripts colon (:) separated format.
Option Explicit
Const max_rows As Integer = 200
Sub ListFiles()
Const merge_sheet_name As String = "Merge Sheet"
Dim sh As Worksheet
Dim DestSalesSh As Worksheet
Dim DestSalesIdx As Integer
Dim DestExpencesSh As Worksheet
Dim DestExpencesIdx As Integer
Dim FolderPath As String
Dim FilePath As String
Dim FullFilePath As String
Dim wkb As Workbook
DestSalesIdx = 1
DestExpencesIdx = 1
Set DestSalesSh = RecreateWorksheet("Sales")
Set DestExpencesSh = RecreateWorksheet("Expences")
FolderPath = ActiveWorkbook.Sheets("Control").Cells(2, 2)
FilePath = Dir(FolderPath)
Do Until Len(FilePath) < 1
FullFilePath = FolderPath & FilePath
If Not (EndsWith(FilePath, "xlsx")) Then GoTo ContinueDoLoop
Set wkb = Workbooks.Open(FullFilePath)
LoadSheetsFromFile DestSh:=DestSalesSh, wkb:=wkb, DestIdx:=DestSalesIdx, StartCol:=1
LoadSheetsFromFile DestSh:=DestExpencesSh, wkb:=wkb, DestIdx:=DestExpencesIdx, StartCol:=3
wkb.Close savechanges:=False
ContinueDoLoop:
FilePath = Dir()
Loop
End Sub
Sub LoadSheetsFromFile(DestSh As Worksheet, wkb As Workbook, ByRef DestIdx As Integer, StartCol As Integer)
Dim DateValue As Range
Dim sh As Worksheet
Dim i As Integer
For Each sh In wkb.Worksheets
If sh.name <> DestSh.name Then
Set DateValue = sh.Cells(1, 5)
For i = 2 To max_rows
If sh.Cells(i, StartCol) <> "" And Not (sh.Cells(i, 1).HasFormula) Then
DestSh.Cells(DestIdx, 1) = DateValue
DestSh.Cells(DestIdx, 2) = sh.Cells(i, StartCol + 0)
DestSh.Cells(DestIdx, 3) = sh.Cells(i, StartCol + 1)
DestIdx = DestIdx + 1
End If
Next
End If
Next
End Sub
Function RecreateWorksheet(name As String) As Worksheet
Dim DestSh
If sheetExists(name) Then
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(name).Delete
Application.DisplayAlerts = True
End If
Set DestSh = ActiveWorkbook.Sheets.Add
DestSh.name = name
Set RecreateWorksheet = DestSh
End Function
'Copied from https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists
Function sheetExists(sheetToFind As String) As Boolean
Dim sheet
sheetExists = False
For Each sheet In Worksheets
If sheetToFind = sheet.name Then
sheetExists = True
Exit Function
End If
Next sheet
End Function
'Copied from http://excelrevisited.blogspot.in/2012/06/endswith.html
Public Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment