If cell contains a certain text in Column A, then get the value in Column B, and copy to Master Worksheet

[vbanoob1234]

Hello everyone,

I have a workbook with several worksheets of accounts, and I have a "Master" worksheet that contains the list of all the accounts on Column A.

I want a macro that goes through each worksheet,
go through row 1 to 100 in Column A
if Column A contains the word, "Subtotal", "Total", "Tax", then pull Column B in the corresponding row.

Eg. John Smith worksheet (Sheet 2)
Column A Column B
Pipe $100
Water Tank $500
Subtotal $600
Tax $50
Total $650

Eg. Carl John worksheet (Sheet 3)
Column A Column B
Heater $500
Furnace $1000
Subtotal $1500
Tax $100
Total $1600


Master Worksheet (wanted Outcome)
Column A Column B Column C Column D (fixed)
Account Name Subtotal Tax Total (fixed)
John Smith $600 $50 $650
Carl John $1500 $100 $1600

Thank you!

 

[sericom]

So there's a worksheet for each account, and the worksheet name matches the names in column A of the master?
Will there be multiple sub, tax and totals on the worksheets? If so, do they get added together?

 

[vbanoob1234]

So there's a worksheet for each account, and the worksheet name matches the names in column A of the master?
Will there be multiple sub, tax and totals on the worksheets? If so, do they get added together?

Hi Sericom,

No there will only be one subtotal, tax, and total on the worksheets.

Thanks!!!

 

[sericom]

Try this,

Sub fillMaster()
    Dim master As Worksheet
    Dim account As Worksheet
    Dim subTot As Range
    Dim tax As Range
    Dim total As Range
    
    Set master = Sheets("Master") 'Master sheetname
    For Each c In master.Range("A2:A" & Range("A" & master.Rows.Count).End(xlUp).Row) 'range of account names on master, adjust to suit
        On Error Resume Next
        Set account = Worksheets(c.Value)
        On Error GoTo 0
        If Not account Is Nothing Then
            With account.Range("A1:A" & account.Range("A" & account.Rows.Count).End(xlUp).Row)
                Set subTot = .Find("subtotal", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                Set tax = .Find("tax", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                Set total = .Find("total", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            End With
            If Not subTot Is Nothing Then c.Offset(, 1) = subTot.Offset(, 1)
            If Not tax Is Nothing Then c.Offset(, 2) = tax.Offset(, 1)
            If Not total Is Nothing Then c.Offset(, 3) = total.Offset(, 1)
        Else
            MsgBox "Worksheet for account " & c.Value & " doesn't exist"
        End If
        Set account = Nothing
    Next
End Sub

 

[vbanoob1234]

Try this,

Sub fillMaster()
    Dim master As Worksheet
    Dim account As Worksheet
    Dim subTot As Range
    Dim tax As Range
    Dim total As Range
    
    Set master = Sheets("Master") 'Master sheetname
    For Each c In master.Range("A2:A" & Range("A" & master.Rows.Count).End(xlUp).Row) 'range of account names on master, adjust to suit
        On Error Resume Next
        Set account = Worksheets(c.Value)
        On Error GoTo 0
        If Not account Is Nothing Then
            With account.Range("A1:A" & account.Range("A" & account.Rows.Count).End(xlUp).Row)
                Set subTot = .Find("subtotal", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                Set tax = .Find("tax", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
                Set total = .Find("total", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            End With
            If Not subTot Is Nothing Then c.Offset(, 1) = subTot.Offset(, 1)
            If Not tax Is Nothing Then c.Offset(, 2) = tax.Offset(, 1)
            If Not total Is Nothing Then c.Offset(, 3) = total.Offset(, 1)
        Else
            MsgBox "Worksheet for account " & c.Value & " doesn't exist"
        End If
        Set account = Nothing
    Next
End Sub

Hi sericom,
This is not work. It is saying Worksheet for Account 100 doesn't exist and so forth.

Thanks

 

[sericom]

Do you have a worksheet called 100?

So there's a worksheet for each account, and the worksheet name matches the names in column A of the master?

 

[vbanoob1234]

Do you have a worksheet called 100?

Hi Sericom,

Yes I have a worksheet called 100.

Thanks

 

[sericom]

Try changing

Set account = Worksheets(c.Value)

to

Set account = Worksheets(c.Text)

 

[vbanoob1234]

Try changing

Set account = Worksheets(c.Value)

to

Set account = Worksheets(c.Text)

Hi Sericom,

This worked like a charm. You are great!

Do you mind elaborating on the macro a bit? So I can understand it more.
I am a bit confused on the part below:

" If Not account Is Nothing Then With account.Range("A1:A" & account.Range("A" & account.Rows.Count).End(xlUp).Row)
Set subTot = .Find("subtotal", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Set tax = .Find("tax", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Set total = .Find("total", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
End With
If Not subTot Is Nothing Then c.Offset(, 1) = subTot.Offset(, 1)
If Not tax Is Nothing Then c.Offset(, 2) = tax.Offset(, 1)
If Not total Is Nothing Then c.Offset(, 3) = total.Offset(, 1)"


Thanks a million!

 

[vbanoob1234]

Hi sericom,

I am stumped once again. I am trying to do the same VBA macro for a different worksheet.
Basically, I want my macro to open all workbooks in this file, create a worksheet called "Master", list all of the worksheets, then make the macro go through all worksheets in the workbook, to find the number that corresponds with "Total:"

It is saying that the worksheet can not be found. I tried changing it to c.value, and c.text.
Still didn't budge.


Here is what I got so far.
Sub SuspendedLoss()


' Printsheets Macro




Dim wb As Workbook, ws As Worksheet
Dim sFil As String, sPath As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet




Application.ScreenUpdating = True


'OPENS THE PATH
sPath = "G:\VBA\ARFilesTesting" 'location of files, don't forget the "" at the end
sFil = Dir(sPath & "*.xls") 'change or add formats




Application.DisplayAlerts = False


'FIND ALL THE FILES TO PRINT
Do Until sFil = ""
Workbooks.Open sPath & sFil
Set wb = ActiveWorkbook


Application.ScreenUpdating = False


'CREATE A WORKSHEET AT THE END CALLED "MASTER"
Set wsht = ActiveWorkbook.Sheets.Add(After:= _
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
wsht.Name = "Master"


'LIST ALL WORKSHEETS NAMES
Dim x As Integer


For x = 1 To Worksheets.Count
Cells(x, 1).Value = Worksheets(x).Name
Next x




'FINDING THE TOTAL: NUMBER


Dim master As Worksheet
Dim account As Worksheet
Dim fundtotal As Range


Set master = Sheets("Master") 'Master sheetname
For Each c In master.Range("A1:A" & Range("A" & master.Rows.Count).End(xlUp).Row) 'range of account names on master, adjust to suit

On Error Resume Next
Set account = Worksheets(c.Text)

On Error GoTo 0
If Not account Is Nothing Then

With account.Range("A1:A" & account.Range("A" & account.Rows.Count).End(xlUp).Row)
Set fundtotal = .Find("TOTAL:", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)



End With
If Not fundtotal Is Nothing Then c.Offset(, 15) = fundtotal.Offset(, 1)



Else
MsgBox "Worksheet for account " & c.Value & " doesn't exist"
End If



ActiveWorkbook.Close savechanges:=True


Next


sFil = Dir()
Loop
Application.DisplayAlerts = True


End Sub


Any help would be greatly appreciated.!