Filter Information From Multiple Sheets Into Master Worksheet

Sazrak · Jun 3rd 2008

I have a memberlist with debts owed per member that I need to organize. There are a lot of members, and so I have organized it alphabetically.
IE the first sheet is called A and contains all entries for members with names beginning with A, the next sheet is called B containing all names with the first letter B, and so forth.

The "A" column contains the name of the member, the "H" column contains the total debt. Not all members have debt, some have positive values in this field. What I need is a macro that copies the value from "A" and "H" for all values of "H" that are less than zero, and compiles them into a single list. I basically wish to be able to browse all members who are in debt, without having to filter 26 separate lists.

Only Columns "A" and "H" are relevant for me, the other rows are merely used in the calculation of said debt.
The value in "H" is thus the result of a calculation, and not a typed number.
The number of columns will never vary, but the number of rows might as members come and go.
The worksheet number for the list will be number 27, I do not know if that is relevant.

Robert B · Jun 3rd 2008

Re: Filter Information From Multiple Sheets Into Master Worksheet

Hi and welcome to the forum

As you have found, splitting a database over a number of worksheets causes limitations when you attempt to manipulate or sort data, so I would recommend putting all your member details on 1 worksheet, unless, of course, you have more than 65k members, this will enable you to apply filters in the usual way

Robert

**Trebor76** · Jun 3rd 2008

Re: Filter Information From Multiple Sheets Into Master Worksheet

Hi Sazrak,

Agree with Robert B, but here's a macro I built from this post by Dave and this UDF by Aaron Blood (just note it assumes the data in each tab starts at row 2):

Code

Sub ConsolidateDebts()


    Dim wSheet As Worksheet
    Dim rCopy As Range
    Dim rPaste As Range
    Dim lngLastRow As Long
    
    Sheets("27").Select
    
    'Clear existing (if any) data
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A2:H" & lngLastRow).ClearContents
     
    'Consolidate data
    For Each wSheet In Worksheets
        If wSheet.Name <> ActiveSheet.Name Then 'Mine
            With wSheet
                lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                Set rCopy = .Range("A2:H" & lngLastRow)
            End With
            Set rPaste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2, 1)
            rCopy.Copy
            rPaste.PasteSpecial xlValues
            Application.CutCopyMode = False
        End If
    Next wSheet
    
'Mark values less than zero with a 1.
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("I2").Formula = "=IF(H2<0,1,0)"
    Range("I2").Copy Range("I3:I" & lngLastRow)
    'paste = Range("I2:I" & lngLastRow).PasteSpecial xlPasteValues
'Delete all non 1's (i.e. all zero and positive values).
Find_Range(0, Columns("I")).EntireRow.Delete


Columns("I").Delete
Range("A2").Select


MsgBox "Debt balances have now been consolidated in the ""27"" tab.", vbInformation, "Debt Consolidation Editor"


End Sub
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False
     
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

Display More

HTH

Robert

Sazrak · Jun 3rd 2008

Re: Filter Information From Multiple Sheets Into Master Worksheet

Thank you so much from your help.
This updates my master sheet with all the information from all my other worksheets, right?
So then I'm just filtering that sheet the normal way, which is no hassle. Excellent stuff.

I do however receive one error:

"Named Argument Not Found" in the Following Section

Code

Set c= .Find( _
What:=Find_Item, _
Lookin:=Lookin, _
LooAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
SearchFormat:= False) '<-----"Named Argument Not Found" is here
If Not c is Nothing Then
Set Find_Range = c
firstAddress = c.Address
Do
Set Find_range = Union(Find_Range, c)
Set c= .FinedNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With


End Function

Display More

Thanks for the help guys, I really appreciate it. You have no idea how much hassle you guys save people every day with help like this =)

**Trebor76** · Jun 4th 2008

Re: Filter Information From Multiple Sheets Into Master Worksheet

Hi there,

Thanks for the feedback

Yes, the ConsolidateDebts macro updates the master sheet (i.e. tab "27") with any negatives from all the other sheets in your workbook.

Not sure what the error is as I can't replicate it at my end, but it may be that there are no zero or positive numbers in column H to be deleted. With this in mind, I've tweaked the code below to cater for this.

HTH

Robert

Code

Sub ConsolidateDebts()
     
    Dim wSheet As Worksheet
    Dim rCopy As Range
    Dim rPaste As Range
    Dim lngLastRow As Long
     
    Sheets("27").Select
     
     'Clear existing (if any) data
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
        If lngLastRow > 1 Then
            Range("A2:H" & lngLastRow).ClearContents
        End If
     
     ' Consolidate data
    For Each wSheet In Worksheets
        If wSheet.Name <> ActiveSheet.Name Then 'Mine
            With wSheet
                lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                Set rCopy = .Range("A2:H" & lngLastRow)
            End With
            Set rPaste = ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2, 1)
            rCopy.Copy
            rPaste.PasteSpecial xlValues
            Application.CutCopyMode = False
        End If
    Next wSheet
     
     'Mark values less than zero with a 1.
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("I2").Formula = "=IF(H2<0,1,0)"
    Range("I2").Copy Range("I3:I" & lngLastRow)
          
    'If all the balances are less than zero, there's no need to run the _
    Find_Range UDF below.
    If lngLastRow - 1 = _
        Application.WorksheetFunction.CountIf(Range("I2:I" & lngLastRow), 1) Then
        Columns("I").Delete
        Range("A2").Select
    'If there any balances greater than zero, we need to run the _
    Find_Range UDF below to remove them.
    Else
        Find_Range(0, Columns("I")).EntireRow.Delete
        Columns("I").Delete
        Range("A2").Select
    End If


lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    If lngLastRow = 1 Then
        MsgBox "There are no debt (negative) balances to be reported.", _
        vbInformation, "Debt Consolidation Editor"
    Else
        MsgBox "Debt balances have now been consolidated in the " & _
        """27"" tab.", vbInformation, "Debt Consolidation Editor"
    End If
     
End Sub
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As Variant, _
    Optional LookAt As Variant, _
    Optional MatchCase As Boolean) As Range
     
    Dim c As Range
    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False
     
    With Search_Range
        Set c = .Find( _
        What:=Find_Item, _
        LookIn:=LookIn, _
        LookAt:=LookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=MatchCase, _
        SearchFormat:=False)
        If Not c Is Nothing Then
            Set Find_Range = c
            firstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
             Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
     
End Function

Display More

Sazrak · Jun 4th 2008

Re: Filter Information From Multiple Sheets Into Master Worksheet

That's perfect! Thank you very much!

Filter Information From Multiple Sheets Into Master Worksheet

Participate now!

Share