VBA to pull data from Multiple Worksheets into One

[Haree]

Hello,
I am very new to Excel VBA, i have worked on a few codes based on the forums available on MR Excel. I currently require a vba code for Debtors Management. I have 12 worksheets in a workbook each one for a separate month, in which i have a column called category in which i enter Debtors to identify them and later when i receive them i categorize them under the name Debtors Received.
Now i want a separate sheet called debtors to pull all the rows categorized as debtors and debtors received from all the 12 sheets and show me the current Balance.Since i am very new i am quite blank. Any ideas would be appreciated.
Thank You
Regards
Haree

 

[mumps]

Can you post a screen shot of what your data looks like? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-...forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data. Working with your actual file will make it easier to test possible solutions.

 

[Haree]

Can you post a screen shot of what your data looks like? Section B at this link has instructions on how to post a screen shot: https://www.mrexcel.com/forum/board-...forum-use.html Alternately, you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data. Working with your actual file will make it easier to test possible solutions.

Hello Mumps,
I am attaching a sample Excel. I want the sheet named Debtors to be fully auto populated and updated regularly.
https://www.dropbox.com/s/tz7fuix6thr7nt8/Sample Excel.xlsx?dl=0

Thank You.

 

[mumps]

If I understood correctly, should Sam not have a balance of 3600 in cell L4 of the Debtors sheet?

 

[Haree]

If I understood correctly, should Sam not have a balance of 3600 in cell L4 of the Debtors sheet?

I am so sorry, yes he should have

 

[mumps]

Start with only the headers in the Debtors sheet and try this macro:

Sub GetBalance()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, CustName As Range, desWS As Worksheet, fnd As Range, sAddr As String
    Set desWS = Sheets("Debtors")
    For Each ws In Sheets
        If ws.Name <> "Debtors" And ws.Name <> "Debtors (2)" Then
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For Each CustName In ws.Range("J2:J" & LastRow)
                If CustName <> "" Then
                    If WorksheetFunction.CountIf(desWS.Range("K:K"), CustName) = 0 Then
                        With desWS
                            .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0) = CustName
                        End With
                    End If
                End If
            Next
        End If
    Next ws
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each CustName In desWS.Range("K3:K" & LastRow)
        For Each ws In Sheets
            If ws.Name <> "Debtors" And ws.Name <> "Debtors (2)" Then
                Set fnd = ws.Range("J:J").Find(CustName, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    sAddr = fnd.Address
                    Do
                        If fnd.Offset(, -4) = "Debtors" Then
                            With desWS
                                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = fnd.Offset(, -5)
                                .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = CustName
                                fnd.Offset(, -3).Resize(, 2).Copy .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
                            End With
                        ElseIf fnd.Offset(, -8) = "Debtors Received" Then
                            With desWS
                                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = fnd.Offset(, -9)
                                .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0) = CustName
                                fnd.Offset(, -7).Resize(, 2).Copy .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0)
                            End With
                        End If
                        Set fnd = ws.Range("J:J").FindNext(fnd)
                    Loop While fnd.Address <> sAddr
                    sAddr = ""
                End If
            End If
        Next ws
    Next CustName
    With desWS
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each CustName In .Range("B2:B" & LastRow - 1)
            .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0) = CustName.Offset(, 2) - CustName.Offset(, 6)
        Next CustName
    End With
    Application.ScreenUpdating = True
End Sub

 

[Haree]

Start with only the headers in the Debtors sheet and try this macro:

Sub GetBalance()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, CustName As Range, desWS As Worksheet, fnd As Range, sAddr As String
    Set desWS = Sheets("Debtors")
    For Each ws In Sheets
        If ws.Name <> "Debtors" And ws.Name <> "Debtors (2)" Then
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For Each CustName In ws.Range("J2:J" & LastRow)
                If CustName <> "" Then
                    If WorksheetFunction.CountIf(desWS.Range("K:K"), CustName) = 0 Then
                        With desWS
                            .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0) = CustName
                        End With
                    End If
                End If
            Next
        End If
    Next ws
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each CustName In desWS.Range("K3:K" & LastRow)
        For Each ws In Sheets
            If ws.Name <> "Debtors" And ws.Name <> "Debtors (2)" Then
                Set fnd = ws.Range("J:J").Find(CustName, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    sAddr = fnd.Address
                    Do
                        If fnd.Offset(, -4) = "Debtors" Then
                            With desWS
                                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = fnd.Offset(, -5)
                                .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = CustName
                                fnd.Offset(, -3).Resize(, 2).Copy .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
                            End With
                        ElseIf fnd.Offset(, -8) = "Debtors Received" Then
                            With desWS
                                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = fnd.Offset(, -9)
                                .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0) = CustName
                                fnd.Offset(, -7).Resize(, 2).Copy .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0)
                            End With
                        End If
                        Set fnd = ws.Range("J:J").FindNext(fnd)
                    Loop While fnd.Address <> sAddr
                    sAddr = ""
                End If
            End If
        Next ws
    Next CustName
    With desWS
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each CustName In .Range("B2:B" & LastRow - 1)
            .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0) = CustName.Offset(, 2) - CustName.Offset(, 6)
        Next CustName
    End With
    Application.ScreenUpdating = True
End Sub

Dear Mumps
Thank You So so much for the timely help. This would really save my time. I have a few corrections, i have uploaded a another excel copy with the code enabled. Please have look into it.
Thank You So Much.
The Excel Link is
https://www.dropbox.com/s/nclqhy2bnzr8ghh/Sample Excel 2.xlsm?dl=0
Regards
Haree

 

[mumps]

Replace this line of code:

For Each CustName In desWS.Range("K3:K" & LastRow)

with this line:

For Each CustName In desWS.Range("K2:K" & LastRow)

In the file you originally posted, you had the names in column K in the Debtors sheet starting in row 3. Now they start in row 2.

 

[Haree]

Replace this line of code:

For Each CustName In desWS.Range("K3:K" & LastRow)

with this line:

For Each CustName In desWS.Range("K2:K" & LastRow)

In the file you originally posted, you had the names in column K in the Debtors sheet starting in row 3. Now they start in row 2.

I am so sorry for that trouble. I am feeling very guilty to trouble you again, I have a few doubts which i have attached with the file workings itself. Could you please help me out with the same. I seriously owe you lots.
Thanks.

The Link is attached Below
https://www.dropbox.com/s/q3dz9yn48rxlesc/Sample Excel 3.xlsm?dl=0

 

[mumps]

Can you please upload a file which contains a "Debtors" sheet that shows the expected results based on the data in the file? Also, when replying, please click the "Reply" button instead of the "Reply With Quote" button. It keeps responses less cluttered.