Excel summary from 4 tables in the same sheet

Nando1988

New Member
Joined
Aug 21, 2019
Messages
23
I have an excel sheet that has 4 tables, one below the other, and they have a set of names and costs in certain columns.
I need to make a summary, that includes the four tables in all the sheets in the workbook.
This is the code I have, but it only works for the first table, and the other tables are not taken into account.
Code:
Sub prueba()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh As Worksheet, c As Range, f As Range, j As Long
  
  Set sh1 = Sheets("Nombres Naranjo")
  Set sh2 = Sheets("Resumen Naranjo")
  Set sh3 = Sheets("Nombres Paraíso")
  Set sh4 = Sheets("Resumen Paraíso")
  sh2.Rows("2:" & Rows.Count).ClearContents
  
  j = 2
  For Each c In sh1.Range("A2:A800")
    For Each sh In Sheets
      Select Case sh.Name
        Case sh1.Name, sh2.Name
        Case Else
        If Not IsEmpty(sh1.Range("B2").Value) Then
            If sh.Name Like sh1.Range("B2").Value + "*El Naranjo" Then
                Set f = sh.Range("B2:B1048576").Find(c, , xlValues, xlWhole)
                If Not f Is Nothing Then
                    sh2.Cells(j, "A").Value = c
                    sh2.Cells(j, "B").Value = f.Offset(, 16)
                    sh2.Cells(j, "C").Value = f.Offset(, 50)
                    j = j + 1
                    End If
            End If
            If IsEmpty(sh1.Range("B2").Value) Then
                    sh2.Cells(j, "A").Value = c
                    sh2.Cells(j, "B").Value = f.Offset(, 16)
                    sh2.Cells(j, "C").Value = f.Offset(, 50)
                    j = j + 1
                    MsgBox "Entered else"
            End If
        End If
      End Select
    Next
  Next
End Sub
Data[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Nombre[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nando[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Miguel
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nombre[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Nando[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Miguel[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

The result I am looking for is Nando,2,2 and miguel,4,4.
The columns in which I have data are the following: R and AZ.
Please let me know how I can include all the other tables in the summary, that are below the first table, which is the only one included.
Thanks.
wgR0dWN

wgR0dWN
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Hi @Nando1988, lets start with this, try and tell me.

Code:
Sub prueba()
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh As Worksheet
  Dim hojas, resus, c As Range, f As Range, j As Long, s As Long
  
  hojas = Array("Nombres Naranjo", "Nombres Paraíso")
  resus = Array("Resumen Naranjo", "Resumen Paraíso")
  
  For s = 0 To UBound(hojas)
    Set sh1 = Sheets(hojas(s))
    Set sh2 = Sheets(resus(s))
    sh2.Rows("2:" & Rows.Count).ClearContents
    j = 2
    For Each c In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
      Set f = sh2.Range("A:A").Find(c, , xlValues, xlWhole)
      If Not f Is Nothing Then
          sh2.Cells(f.Row, "B").Value = sh2.Cells(f.Row, "B").Value + c.Offset(, 16)
          sh2.Cells(f.Row, "C").Value = sh2.Cells(f.Row, "C").Value + c.Offset(, 50)
      Else
          sh2.Cells(j, "A").Value = c
          sh2.Cells(j, "B").Value = c.Offset(, 16)
          sh2.Cells(j, "C").Value = c.Offset(, 50)
          j = j + 1
      End If
    Next
  Next
  MsgBox "Fin"
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,313
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top