VBA to loop through sheets in workbooks in a file directory and add missing columns

[ipmh97]

Hi, I need to access different sheets across different workbooks and consolidate the data into one consolidate file.
I'm thinking of just using the Power Query function on excel to do the consolidation. However, one issue I foresee before joining using power query is that some of the sheets have missing columns. I have gotten a vba to insert any missing columns in their appropriate position. However, I'm not sure of how to edit the code to make it loop through the different workbooks and sheets. I only need the code to run through specific sheets and specific workbooks (ie Only check sheets with "New" or "Continue" in their sheet titles and only check the excel files with "Report" in their names). Thank you for the help!




Sub AddMissingHeader()
Dim headers() As Variant
headers = Array("Report_Date", "Company", "Customer_Id", "Product_Id", "Company_Name")
Dim i As Long
For i = LBound(headers) To UBound(headers)
If Cells(5, i + 1).Value <> headers(i) Then
Columns(i + 1).EntireColumn.Insert
Cells(5, i + 1).Value = headers(i)
End If
Next i
End Sub

[arnelgp]

you can use this to recurse through the folder:

Public Sub RecursiveDir(ByRef colFiles As Collection, _
ByVal strFolder As String, _
ByVal strFileSpec As String, _
ByVal bIncludeSubfolders As Boolean, _
ParamArray FileNameLike() As Variant)


Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim varName As Variant

On Error Resume Next
'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir$(strFolder & strFileSpec)
Do While strTemp <> vbNullString
For Each varName In FileNameLike
If strTemp Like "*" & varName & "*" Then
colFiles.Add strFolder & strTemp
Exit For
End If
Next
strTemp = Dir$
Loop


If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop


'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
Next vFolderName
End If


End Sub




Private Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
If Right(strFolder, 1) = "\" Then
TrailingSlash = strFolder
Else
TrailingSlash = strFolder & "\"
End If
End If
End Function




Private Sub test()
Dim files As New Collection
Dim i As Long
Call RecursiveDir(files, "d:\", "*.xlsx", False, "report")
For i = 1 To files.Count
Debug.Print files(i)
Next
End Sub




to recurse through each Sheets:


Dim i As IntegerDim strName as string
For i = 1 To Sheets.Count
strName = Sheets(i).Name
If Instr(1, strName, "New") Or Instr(1, strName, "Continue") Then
'your code here
End If
Next