Reputation: 1
I am really new to VBA and I have just been learning the basics and the VBA language recently from Youtube and communities such as these. Therefore, any help will be really appreciated!
I am trying to consolidate excel worksheets from different excel workbooks into a main excel workbook. The excel workbooks are all found in the same file. However, they are named differently and I only have the partial names for the excel workbooks e.g. "ABG_RSPB_xxxxx-yyyy".
I will have a main workbook in the folder consolidating the data from all the different workbook and worksheets. Each workbook where the data is extracted from only has one worksheet and the template in each worksheet is the same. They have the same headers as well. All the workbooks are csv format. However the worksheets have partial names as well (the worksheet will have the same name as the workbook it is in).
Currently, I have a macro that provides a similar function however, it can't extract workbooks and worksheets with partial names.
Any help to amend the macro such that it can extract from partial workbooks and worksheets will be deeply appreciated. Thank you!
Current code:
Sub consolidation ()
Set mainWB = ActiveWorkbook
Dim mainPath As String
mainPath = ThisWorkbook.Path
Dim mainRowstart As Integer
mainRowstart = 2
Dim mainRC As Integer
mainRC = lastRow ("Consolidated Trades", "A") + 1
If mainRC < mainRowStart Then
mainRC = mainRowStart
EndIf
Dim fso As Object
Dim folder As Object
Dim files As Object
Set fso = CreateObject ("Scripting.FileSystemObject")
Set folderPaths = fso.getfolder (mainPath)
set filePaths = folderPath.files
Dim curFile As String
Dim curPath As String
Dim curRC As Integer
Dim curWSName As String
curWSName = ""
For Each filePath In filePaths
curPath = filePath
curFile = Split (curPath, "\")(UBound(Split(curPath, "\")))
If Left (curFile, 1) <> "~" Then
If curFile <> "ABG_RSPB_xxxxx=yyy.csv" Then
If Right (curFile, Len ("ABG_RSPB_xxxxx=yyy.xlsm")) = "ABG_RSPB_xxxxx=yyy.xlsm" Or _ Right (curFile, Len("ABG_RSPB_xxxxx=yyy.xls")) = "ABG_RSPB_xxxxx=yyy.xls" Then
Workbooks.Open Filename: = curPath
Workbooks (curFile).Activate
For Each ws In Worksheets
If ws.Name = "ABG_RSPB_xxxxx=yyy.csv" Then
curWSName = ws.Name
End If
Next Ws
curRC = lastRow(CurWSName, "A")
mainWB.Activate
mainRC = lastrow("Consolidated Trades", "A") + 1
If curRC >= 2 Then
mainWB.Worksheets("Consolidated Trades").Range("A" & mainRC & ":U: & mainRC + curRC - 2).Value = _ Workbooks(curFile).Worksheets(curWSName).Range("A2:U" & curRC).Value
mainWB.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = curFile & "with" & curRC -1 & "Rows of Data"
EndIf
Workbooks(curFile).Close
EndIf
EndIf
EndIf
NextfilePath
MsgBox "Process Complete"
End Sub
Upvotes: 0
Views: 129
Reputation: 550
If I've understood you correctly, you have some csv files besides your main workbook and you want to iterate over all csv files and read all values in the first column of the first sheet of each file and then write them into the first column of the main workbook, right? I've assumed that:
Please see if the following code does the job correctly. If there is any problem, please leave a comment below, I'll see and edit my code as you want.
Sub consolidation()
Dim mainRowstart As Integer
mainRowstart = 2
Dim mainRC As Integer
mainRC = lastrow("Consolidated Trades", "A") + 1 'I've assumed that you have another sub called "lastrow"
If mainRC < mainRowstart Then
mainRC = mainRowstart
End If
'======================================================================================================
' 1- Get all csv files in this workbook's path
'======================================================================================================
Dim allCsvFiles() As Variant
allCsvFiles = GetFileList(ThisWorkbook.path, "csv")
'======================================================================================================
' 2- Loop over and read/write all data
'======================================================================================================
If IsArray(allCsvFiles) Then 'i.e., at least one file has found
Dim file As Variant
For Each file In allCsvFiles
'Open file
Workbooks.Open (file)
'Activate
Workbooks(file).Activate
'How many rows do exist in the file?
Dim curRC As Integer
curRC = lastrow(Workbooks(file).Sheets(1).Name, "A") 'Hint: as the file is a "csv" file, it always contains only one sheet and there is no need to search and find a specific sheet
If curRC > 2 Then
mainRC = lastrow("Consolidated Trades", "A") + 1 'Is it required to run this function in every iteration???
ThisWorkbook.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = file & " with " & curRC - 1 & " rows of data"
'Read and write data
Dim row As Integer
For row = 2 To curRC
ThisWorkbook.Worksheets("Consolidated Trades").Cells(mainRC, 1).Value = Workbooks(file).Sheets(1).Cells(row, 1).Value
mainRC = mainRC + 1
Next row
End If
'Close file
Workbooks(file).Close False
Next
MsgBox "Process Complete"
End If
End Sub
where GetFileList
is:
Function GetFileList(path As String, FileSpec As String) As Variant
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
FileCount = 0
FileName = Dir(path & "\*." & FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
NoFilesFound:
GetFileList = False
End Function
Upvotes: 0