Search code examples
excelvbasum

VBA to sum column with particular header and capture in a master file


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

Solution

  • 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!