CODEWITHSUNDEEP
excelvba
Tahir Ruzbaev
Tahir Ruzbaev

Reputation: 49

How can i get information from few excel files into master file form a certain column?

Good Day! I have a code that copies all information from some files and inserts it into master file. I would like to modify it. Not to copy it but to sum up.

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range, r as Range
Set Wb = ThisWorkbook

MyDir = "C:\Project\"
MyFile = Dir(MyDir & "*.xlsx") 
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
 
Do While MyFile <> ""
    Workbooks.Open (MyFile)
    For Each r in Rows
    With Worksheets("Sheet1")
        r.Rows.Hidden = False
        Rws = .Cells(Rows.Count, 12).End(xlUp).Row
        Set Rng = Range(.Cells(5, 12), .Cells(Rws, 12))
        Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Offset(0, 1) 'So here I copy infromation adn insert it.
        ActiveWorkbook.Close True
    End With
    Next
    Application.DisplayAlerts = 1
    MyFile = Dir()
Loop

I cannot get my head around it. How do i sum up the same information and instead of copying it. I dont mean sum up all the rows into master file, i would like to sum up same rows from different files into one master file.

Another thing, few files contain hidden rows, mayhaps im doing something wrong but those rows are still being hidden

r.Rows.Hidden = False

does not seem to do the thing. Any help would be much appreciated

Structure: All files are the same structure-wise, master-file is the same file but without any information in it, just the header. - first 4 rowsenter image description here Column 12 ("L") - is last one has the information i need, or will have i should say. Every Row has an ID that differ it from any other(column 1 - "A"). All documents all very similar, Items in those rows are the same, only difference is the quantity in the last column, which what i need to count. Master file: Row - Item - Quantity from All other files.

Upvotes: 2

Views: 129

Answers (1)

DecimalTurn
DecimalTurn

Reputation: 4127

You could try this:

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range, r As Range
Set Wb = ThisWorkbook

MyDir = "C:\Project\"
MyFile = Dir(MyDir & "*.xlsx")
ChDir MyDir
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Do While MyFile <> ""
    
    Dim sWb As Workbook
    Set sWb = Workbooks.Open(MyFile)
    
    With sWb.Worksheets("Sheet1")
        .Rows.Hidden = False
        Rws = .Cells(Rows.Count, 12).End(xlUp).Row
        Set rng = Range(.Cells(5, 1), .Cells(Rws, 12))
    End With
    
    With Wb.Worksheets("Sheet1")
        Dim MatchingColumn As Range
        Set MatchingColumn = .Range(.Cells(5, 1), .Cells(.Rows.Count, 1).End(xlUp))
    
        For Each r In rng.Rows
            If r.Cells(1, 1).Value2 <> vbNullString Then 'Ignoring empty rows
                
                'We find the row where the Ids matche
                Dim MatchingRowNb As Long
                MatchingRowNb = Application.Match(r.Cells(1, 1).Value2, MatchingColumn, False)
                    
                'We add the current value in the cell with the new value comming from the other file
                .Cells(4 + MatchingRowNb, 12).Value2 = .Cells(4 + MatchingRowNb, 12).Value2 + r.Cells(1, 12).Value2
            End If
        Next
    End With
    
    sWb.Close SaveChanges:=True

    Application.DisplayAlerts = True
    MyFile = Dir()
Loop

Upvotes: 2

Related Questions