Vlookup Grand Total Amount in Multiple Sheets (100 sheets)

September 4, 2017 at 05:24:56
Specs: Windows 8
Dear Everyone,

I have a "Summary" sheet and other sheets namely "Sheet A", "Sheet B", "Sheet C", "Sheet D", "Sheet E",
"Sheet F", "Sheet G", "Sheet H", "Sheet I". In those sheets from "Sheet A" to "Sheet I" has the word
"Grand Total" at the bottom in column B which varies in location due to different sets of data. Beside the
word Grand Total is the total amount in Column C. While in "Summary" sheet collates the Grand Total
from "Sheet A" to "Sheet I". In the Summary sheet has the following data:

A2 = "Sheet A"
A4 = "Sheet B"
A6 = "Sheet C"
A8 = "Sheet D"
A10 = "Sheet E"
A12 = "Sheet F"
A14 = "Sheet G"
A16 = "Sheet H"
A18 = "Sheet I"

A50 = "Sheet Names"
B50 = "Prepared by:"

Then I have the following code which I want to have a value in column C of Summary sheet

Private Sub Worksheet_Activate()

COUNTER = 4 'row of Summary 'start of Amount Value
COUNTER2 = 1 'column of Sheet Name
COUNTER3 = 3 ' column of Name - Prepared by:
lett = 3 'column C where the amount will be placed

Dim sheet As Worksheet

Do Until ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value <> ""
COUNTER = COUNTER + 1
Loop

Do Until ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value = "Sheet Names"
If ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value <> "" Then
ThisWorkbook.ActiveSheet.Cells(COUNTER, 3).Value = _
Application.WorksheetFunction.VLookup("Grand Total", ThisWorkbook.Sheets("A").Range("B3:C3000"), 2, False)

lett = lett + 1

ElseIf ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value = "" Then
ThisWorkbook.ActiveSheet.Cells(COUNTER, 3).Value = ""
End If
COUNTER = COUNTER + 1

If ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER3).Value = "Prepared by:" Then
lett = 3

End If

Loop

End Sub

My question is how will I reference the Sheets "B" to Sheets "I" to gather to Grand Total Amount?
What if I have 100 sheets?

Thank you,


See More: Vlookup Grand Total Amount in Multiple Sheets (100 sheets)

Reply ↓  Report •

#1
September 4, 2017 at 07:30:42
I'm a bit confused.

You say that you have sheets that are named "Sheet A", "Sheet B", etc. but your code references ThisWorkbook.Sheets("A"). That is going to cause an error because you don't have a sheet named "A". Did you mean that you have sheets named "A", "B", etc?

In any case, the following code does not reference explicit sheets names in the code. Instead it uses the values in Summary!Column A as the sheet names. Assuming that your exact sheet names are in A2, A4, A6 (every other row), then try the following code.

Hopefully the including comments help explain what the code is doing.

Sub GrandTotals()
Dim numShts As Long, dstRw As Long
Dim shtName As String
Dim gt As Range

'Determine number of Data sheets (not including Summary sheets)
numShts = Sheets.Count - 1

'Loop through Destination rows
'Every other Row, starting at Row 2, based the number of Data sheets
 For dstRw = 2 To numShts * 2 Step 2

'Get Sheet Name from Summary Sheet, Column A
  shtName = Sheets("Summary").Cells(dstRw, 1)

'Find "Grand Total" in Column B of target sheet (shtName)
   With Sheets(shtName).Columns(2)
    Set gt = .Find("Grand Total")

'Place value from Column C of target sheet into Summary sheet
     Sheets("Summary").Cells(dstRw, 3) = Sheets(shtName).Cells(gt.Row, 3)
   End With

 Next
End Sub

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

#2
September 5, 2017 at 02:55:54
Hi DerbyDad03,

Apology for the wrong information. The name of sheets should be "A" "B" and so on. I used your code similar to this one last September 15, 2015 and it work combining my code above see combined code below

Private Sub Worksheet_Activate()

Dim dstRw As Long
Dim c As Range

dstRw = 2
'Loop through Sheet 2 through last sheet
     For shtNum = 2 To Sheets.Count
'Search entire sheet(s) for Grand Total value
       With Sheets(shtNum).Cells
        Set c = .Find("Grand Total")
'If value is found, place Sheet Name and Cell Address in the
'next Row in Columns
           If Not c Is Nothing Then
              FirstAddress = c.Address
                Do
                
                dstRw = dstRw + 1
                Sheets(1).Cells(dstRw, "A") = Sheets(shtNum).Name
               Sheets(1).Cells(dstRw, "C") = c.Offset(0, 1)
               
'Continue searching individaul sheet(s) until all values are found
                 Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> FirstAddress
           End If
       End With
     Next
     
COUNTER = 4 'row of Summary 'start of Amount Value
COUNTER2 = 1 'column of Sheet Name
COUNTER3 = 2 ' column of Name - Prepared by:
lett = 2 'column B where the Name of code will be placed

Dim sheet As Worksheet

Do Until ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value <> ""
COUNTER = COUNTER + 1
Loop

Do Until ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value = "Sheet Names"
If ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value <> "" Then
ThisWorkbook.ActiveSheet.Cells(COUNTER, 2).Value = _
Application.WorksheetFunction.VLookup(ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value, ThisWorkbook.Sheets("Code Name").Range("A1:B30"), 2, False)
lett = lett + 1

ElseIf ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value = "" Then
ThisWorkbook.ActiveSheet.Cells(COUNTER, 2).Value = ""
End If
COUNTER = COUNTER + 1

If ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER3).Value = "Prepared by" Then
lett = 2

End If
Loop
End Sub

Then I have additional sheet at the end with sheet name as Code Name. In that sheet contains a data which are:

A1 = A B1 = Apple
A2 = B B2 = Banana
A3 = C B3 = Cucumber
A4 = D B4 = Dog
A5 = E B5 = Elephant

After running the code, the result is something like this

A B C
1
2
3 A Apple 300
4 B Banana 400
5 C Cucumber 900
6 D Dog 500
7 E Elephant 500
8
9
10 Sheet Names Prepared by: Total

My problem is, if I change the sheet name such as A.1 or 1A.1 or 2B1 it create an error. Adding "*" & ThisWorkbook.ActiveSheet.Cells(COUNTER, COUNTER2).Value & "*" after the Vlookup doesnt seem to work as what they refer in partial Vlookup. Can you help me resolve the error without changing the data in the sheet Code Name?

Thanks


Reply ↓  Report •
Related Solutions


Ask Question