I have the below code that, when pointed at a particular folder, will capture the following data in my check tab : file name, number of rows, number of columns. The final part i need help with is to find a header, say its "value", and sum the column, posting the total adjacent to each file name starting in cell d8. Code below. Any ideas how to do this easily?
Sub CollectData()
Dim fso As Object, xlFile As Object
Dim sFolder$
Dim r&, j&, k&
'*
Sheets("Check").Activate
Range("F8:I50").ClearContents
Range("A8:D50").Copy Range("F8")
Range("A8:D50").ClearContents
'*
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.path
If .Show Then sFolder = .SelectedItems(1) Else Exit Sub
End With
Set fso = CreateObject("Scripting.FileSystemObject")
For Each xlFile In fso.GetFolder(sFolder).Files
With Workbooks.Open(xlFile.path, Password:="password")
With .Sheets(1)
j = .Cells(.Rows.Count, 1).End(xlUp).Row
k = .Cells(1, Sheet1.Columns.Count).End(xlToLeft).Column
End With
.Close False
End With
r = r 1
Cells(r 7, 1).Value = xlFile.Name
Cells(r 7, 2).Value = j
Cells(r 7, 3).Value = k
ActiveWorkbook.Save
Next
End Sub
CodePudding user response:
I would just iterate over the header cells and check for cell.value:
Dim headers As Range
Dim c As Range
Dim SumRange As Range
Dim Sum As Double
Set headers = Range("F8:I8")
For Each c In headers
If c.Value = "value" Then
'From the header, go 1 cell down and get range of continous non blank cells
'Set the SumRange variable to this range of cells
Set SumRange = Range(c.Offset(1, 0), c.End(xlDown))
End If
Next
'Iterate over the SumRange cells, and add to Sum variable as you go
For Each c In SumRange
Sum = Sum c.Value
Next
'Display Sum in destination cell
Cells(r 7, 4).Value = Sum
Cheers!