VBA Loop through Column

ksillas

New Member
Joined
Jun 29, 2017
Messages
15
Hey all,

I've been scratching my head for the past 3 days looking for an answer online, so far I've been unsuccessful...

My issue is the following: I have several small tables one after the other (separated by a graph each time) I need to loop through column N (first table header starts at N25), looking for entries that fall between "5:30 AM" and "11:00 PM". When found, I have to select the entire range of the values next to column N (in column O) and copy the ranges in a new sheet. It would be easier if the amounts of rows were the same but they fluctuate by 1 or 2 rows... example of a table below.

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]time (col n)[/TD]
[TD="align: center"]amount (col o)[/TD]
[/TR]
[TR]
[TD="align: center"]5:00 AM[/TD]
[TD="align: center"]1542[/TD]
[/TR]
[TR]
[TD="align: center"]5:30 AM[/TD]
[TD="align: center"]2345[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]11:00 PM[/TD]
[TD="align: center"]4454[/TD]
[/TR]
</tbody>[/TABLE]


<graph here="">GRAPH HERE
</graph>
<graph here="">
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]time (col n)[/TD]
[TD="align: center"]amount (col o)[/TD]
[/TR]
[TR]
[TD="align: center"]5:30 AM[/TD]
[TD="align: center"]1541[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]11:00 PM[/TD]
[TD="align: center"]4242[/TD]
[/TR]
[TR]
[TD="align: center"]11:30 PM[/TD]
[TD="align: center"]5356[/TD]
[/TR]
</tbody>[/TABLE]


<graph here="">GRAPH HERE
</graph>
<graph here="">
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]time (col n)[/TD]
[TD="align: center"]amount (col o)[/TD]
[/TR]
[TR]
[TD="align: center"]4:30 AM[/TD]
[TD="align: center"]7445[/TD]
[/TR]
[TR]
[TD="align: center"]5:00 AM[/TD]
[TD="align: center"]4521[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]11:30 AM[/TD]
[TD="align: center"]4547[/TD]
[/TR]
</tbody>[/TABLE]

So, if I were to do it manually, which is how I'm doing it right now, I would do it like this:
  1. Select values (col O) that match the time between 5:30 AM and 11:00 PM
  2. Copy values & paste them in sheet2 (first range goes in sheet2!B1:B, second range sheet2!C1:C, and so on)
  3. Repeat until done, usually 30 times (since it's usually 1 table per day.)

The end result in sheet2 would look like this, more or less:

[TABLE="class: grid, width: 250, align: center"]
<tbody>[TR]
[TD="align: center"]Time[/TD]
[TD="align: center"]1st table[/TD]
[TD="align: center"]2nd table[/TD]
[TD="align: center"]3rd table[/TD]
[/TR]
[TR]
[TD="align: center"]5:30 AM[/TD]
[TD="align: center"]1542[/TD]
[TD="align: center"]1541[/TD]
[TD="align: center"]7445[/TD]
[/TR]
[TR]
[TD="align: center"]6:00 AM[/TD]
[TD="align: center"]2425[/TD]
[TD="align: center"]3254[/TD]
[TD="align: center"]6242[/TD]
[/TR]
[TR]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[TD="align: center"]...[/TD]
[/TR]
[TR]
[TD="align: center"]11:30 AM[/TD]
[TD="align: center"]4454[/TD]
[TD="align: center"]5356[/TD]
[TD="align: center"]4547[/TD]
[/TR]
</tbody>[/TABLE]

I've been slowly but surely automating my reporting but this one is out of my range of knowledge in VBA..

</graph></graph>
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Hello Ksillas,

Few questions:
  1. Do all tables have the same header (text) in column N?
  2. Could there be any blanks in the table?
  3. Not all tables have the same timings, correct? But in the output sheet, it should have everything - i.e. in your example, the last table starts at 4:30 AM where in your output you have 5:30 AM as a starting point
  4. It is always intervals of 30 minutes?
 
Upvote 0
Hello Ksillas,

Few questions:
  1. Do all tables have the same header (text) in column N?
  2. Could there be any blanks in the table?
  3. Not all tables have the same timings, correct? But in the output sheet, it should have everything - i.e. in your example, the last table starts at 4:30 AM where in your output you have 5:30 AM as a starting point
  4. It is always intervals of 30 minutes?

Hi!

1. Yes. Column N says Time and Column O says Amount
2. No blanks, ever
3. Correct. My output sheet was an example, when the tables generate the timings variate slightly. Sometimes they start at 4:30 a.m. for example.
4. Yes. As I explained on the previous answer, they fluctuate because sometimes our services close earlier than normal.
 
Upvote 0
This was much trickier than I though it would be ... Anyway, try the below code & let me know if it works. Defiantly not the best way to do it with many loops

Code:
Sub Summary()

Application.ScreenUpdating = False

Dim dict As Object
Dim lRow As Long, tbl As Long, tTime As Variant, tValue As Long, ws1 As Worksheet, ws2 As Worksheet, key As Variant

Set ws1 = Sheet1
Set dict = CreateObject("Scripting.Dictionary")
lRow = ws1.Range("N" & Rows.Count).End(xlUp).Row

For x = 25 To lRow
    If IsNumeric(ws1.Cells(x, 14).Value) And Not IsEmpty(ws1.Cells(x, 14).Value) Then
        tTime = ws1.Cells(x, 14).Value
        If Not dict.exists(tTime) Then dict.Add tTime, tTime
    End If
Next x

Worksheets.Add After:=Worksheets(Sheets.Count)
Set ws2 = Worksheets(Sheets.Count)

x = 1
For Each tTime In dict.Keys
    ws2.Cells(x + 1, 1).Value = Format(dict(tTime), "HH:MM AM/PM")
    x = x + 1
Next

dict.RemoveAll

tbl = 1
For x = 25 To lRow
    i = x
    Do While ws1.Cells(i, 14).Value <> ""
            If IsNumeric(ws1.Cells(i, 15).Value) And Not IsEmpty(ws1.Cells(i, 15).Value) Then
                tTime = ws1.Cells(i, 14).Value
                tValue = ws1.Cells(i, 15).Value
                If Not dict.exists(tTime) Then
                    dict.Add tTime, tValue
                End If
            End If
       i = i + 1
    Loop
    For y = 2 To ws2.Range("A" & Rows.Count).End(xlUp).Row
          ws2.Cells(y, tbl + 1).Value = dict(ws2.Cells(y, 1).Value)
    Next y
    dict.RemoveAll
    If ws1.Cells(x - 1, 14).Value = "Time" Then tbl = tbl + 1
Next x

With ws2
    .Cells(1, 1).Value = "Time"
    .UsedRange.Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
End With

For x = 2 To ws2.UsedRange.Columns.Count
    ws2.Cells(1, x).Value = "Tabel " & x - 1
Next x

ws2.Columns(ws2.UsedRange.Columns.Count).EntireColumn.Delete

Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hey mse330,

I tried the code and had to remove the first IsNumeric check, because apparently it's text (even when it displays "4:00 AM")

After that, the macro ran and just copied Column N in a new sheet.

I tried using the MrExcel add-in for the following table, hope it helps.. This is the first table:

Excel 2010[TABLE="class: grid, width: 500"]
<tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TH][/TH]
[TH]N[/TH]
[TH]O[/TH]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C0C0C0]#C0C0C0[/URL] , align: center"]Time[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C0C0C0]#C0C0C0[/URL] , align: center"]Amount[/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD="align: center"]4:30 AM[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD="align: center"]5:00 AM[/TD]
[TD="align: center"]10[/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD="align: center"]5:30 AM[/TD]
[TD="align: center"]11[/TD]
[/TR]
[TR]
[TD="align: center"]29[/TD]
[TD="align: center"]6:00 AM[/TD]
[TD="align: center"]482[/TD]
[/TR]
[TR]
[TD="align: center"]30[/TD]
[TD="align: center"]6:30 AM[/TD]
[TD="align: center"]861[/TD]
[/TR]
[TR]
[TD="align: center"]31[/TD]
[TD="align: center"]7:00 AM[/TD]
[TD="align: center"]1,100[/TD]
[/TR]
[TR]
[TD="align: center"]32[/TD]
[TD="align: center"]7:30 AM[/TD]
[TD="align: center"]1,219[/TD]
[/TR]
[TR]
[TD="align: center"]33[/TD]
[TD="align: center"]8:00 AM[/TD]
[TD="align: center"]1,037[/TD]
[/TR]
[TR]
[TD="align: center"]34[/TD]
[TD="align: center"]8:30 AM[/TD]
[TD="align: center"]1,099[/TD]
[/TR]
[TR]
[TD="align: center"]35[/TD]
[TD="align: center"]9:00 AM[/TD]
[TD="align: center"]1,086[/TD]
[/TR]
[TR]
[TD="align: center"]36[/TD]
[TD="align: center"]9:30 AM[/TD]
[TD="align: center"]1,001[/TD]
[/TR]
[TR]
[TD="align: center"]37[/TD]
[TD="align: center"]10:00 AM[/TD]
[TD="align: center"]1,074[/TD]
[/TR]
[TR]
[TD="align: center"]38[/TD]
[TD="align: center"]10:30 AM[/TD]
[TD="align: center"]1,135[/TD]
[/TR]
[TR]
[TD="align: center"]39[/TD]
[TD="align: center"]11:00 AM[/TD]
[TD="align: center"]1,016[/TD]
[/TR]
[TR]
[TD="align: center"]40[/TD]
[TD="align: center"]11:30 AM[/TD]
[TD="align: center"]996[/TD]
[/TR]
[TR]
[TD="align: center"]41[/TD]
[TD="align: center"]12:00 PM[/TD]
[TD="align: center"]924[/TD]
[/TR]
[TR]
[TD="align: center"]42[/TD]
[TD="align: center"]12:30 PM[/TD]
[TD="align: center"]1,072[/TD]
[/TR]
[TR]
[TD="align: center"]43[/TD]
[TD="align: center"]1:00 PM[/TD]
[TD="align: center"]1,112[/TD]
[/TR]
[TR]
[TD="align: center"]44[/TD]
[TD="align: center"]1:30 PM[/TD]
[TD="align: center"]1,324[/TD]
[/TR]
[TR]
[TD="align: center"]45[/TD]
[TD="align: center"]2:00 PM[/TD]
[TD="align: center"]1,430[/TD]
[/TR]
[TR]
[TD="align: center"]46[/TD]
[TD="align: center"]2:30 PM[/TD]
[TD="align: center"]1,389[/TD]
[/TR]
[TR]
[TD="align: center"]47[/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: center"]1,332[/TD]
[/TR]
[TR]
[TD="align: center"]48[/TD]
[TD="align: center"]3:30 PM[/TD]
[TD="align: center"]1,480[/TD]
[/TR]
[TR]
[TD="align: center"]49[/TD]
[TD="align: center"]4:00 PM[/TD]
[TD="align: center"]1,426[/TD]
[/TR]
[TR]
[TD="align: center"]50[/TD]
[TD="align: center"]4:30 PM[/TD]
[TD="align: center"]1,508[/TD]
[/TR]
[TR]
[TD="align: center"]51[/TD]
[TD="align: center"]5:00 PM[/TD]
[TD="align: center"]1,516[/TD]
[/TR]
[TR]
[TD="align: center"]52[/TD]
[TD="align: center"]5:30 PM[/TD]
[TD="align: center"]1,649[/TD]
[/TR]
[TR]
[TD="align: center"]53[/TD]
[TD="align: center"]6:00 PM[/TD]
[TD="align: center"]1,566[/TD]
[/TR]
[TR]
[TD="align: center"]54[/TD]
[TD="align: center"]6:30 PM[/TD]
[TD="align: center"]1,772[/TD]
[/TR]
[TR]
[TD="align: center"]55[/TD]
[TD="align: center"]7:00 PM[/TD]
[TD="align: center"]1,606[/TD]
[/TR]
[TR]
[TD="align: center"]56[/TD]
[TD="align: center"]7:30 PM[/TD]
[TD="align: center"]1,574[/TD]
[/TR]
[TR]
[TD="align: center"]57[/TD]
[TD="align: center"]8:00 PM[/TD]
[TD="align: center"]1,455[/TD]
[/TR]
[TR]
[TD="align: center"]58[/TD]
[TD="align: center"]8:30 PM[/TD]
[TD="align: center"]1,317[/TD]
[/TR]
[TR]
[TD="align: center"]59[/TD]
[TD="align: center"]9:00 PM[/TD]
[TD="align: center"]991[/TD]
[/TR]
[TR]
[TD="align: center"]60[/TD]
[TD="align: center"]9:30 PM[/TD]
[TD="align: center"]860[/TD]
[/TR]
[TR]
[TD="align: center"]61[/TD]
[TD="align: center"]10:00 PM[/TD]
[TD="align: center"]343[/TD]
[/TR]
[TR]
[TD="align: center"]62[/TD]
[TD="align: center"]10:30 PM[/TD]
[TD="align: center"]18[/TD]
[/TR]
[TR]
[TD="align: center"]63[/TD]
[TD="align: center"]11:00 PM[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]64[/TD]
[TD="align: center"]11:30 PM[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]65[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C0C0C0]#C0C0C0[/URL] , align: center"]Total[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C0C0C0]#C0C0C0[/URL] , align: center"]39796[/TD]
[/TR]
</tbody>[/TABLE]
Sheet1
After this, the graph spans 4 rows every time and a new table begins, same as the one posted beforehand, with changed values.

The result looks like this:

Excel 2010[TABLE="class: grid, width: 500"]
<tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TH][/TH]
[TH]A[/TH]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD]Time[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: right"]12:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: right"]12:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: right"]1:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: right"]1:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: right"]2:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: right"]2:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: right"]3:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: right"]4:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: right"]4:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: right"]5:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]12[/TD]
[TD="align: right"]5:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]13[/TD]
[TD="align: right"]6:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]14[/TD]
[TD="align: right"]6:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]15[/TD]
[TD="align: right"]7:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]16[/TD]
[TD="align: right"]7:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]17[/TD]
[TD="align: right"]8:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]18[/TD]
[TD="align: right"]8:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]19[/TD]
[TD="align: right"]9:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]20[/TD]
[TD="align: right"]9:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]21[/TD]
[TD="align: right"]10:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]22[/TD]
[TD="align: right"]10:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]23[/TD]
[TD="align: right"]11:00 AM[/TD]
[/TR]
[TR]
[TD="align: center"]24[/TD]
[TD="align: right"]11:30 AM[/TD]
[/TR]
[TR]
[TD="align: center"]25[/TD]
[TD="align: right"]12:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]26[/TD]
[TD="align: right"]12:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]27[/TD]
[TD="align: right"]1:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]28[/TD]
[TD="align: right"]1:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]29[/TD]
[TD="align: right"]2:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]30[/TD]
[TD="align: right"]2:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]31[/TD]
[TD="align: right"]3:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]32[/TD]
[TD="align: right"]3:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]33[/TD]
[TD="align: right"]4:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]34[/TD]
[TD="align: right"]4:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]35[/TD]
[TD="align: right"]5:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]36[/TD]
[TD="align: right"]5:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]37[/TD]
[TD="align: right"]6:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]38[/TD]
[TD="align: right"]6:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]39[/TD]
[TD="align: right"]7:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]40[/TD]
[TD="align: right"]7:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]41[/TD]
[TD="align: right"]8:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]42[/TD]
[TD="align: right"]8:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]43[/TD]
[TD="align: right"]9:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]44[/TD]
[TD="align: right"]9:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]45[/TD]
[TD="align: right"]10:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]46[/TD]
[TD="align: right"]10:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]47[/TD]
[TD="align: right"]11:00 PM[/TD]
[/TR]
[TR]
[TD="align: center"]48[/TD]
[TD="align: right"]11:30 PM[/TD]
[/TR]
[TR]
[TD="align: center"]49[/TD]
[TD]Time[/TD]
[/TR]
[TR]
[TD="align: center"]50[/TD]
[TD]Total[/TD]
[/TR]
</tbody>[/TABLE]
Sheet8




 
Upvote 0
Hey ksillas,

I have revamped the code completely ... I am using less sophisticated way but it this might work. Let me know how it goes

Code:
Option Compare Text

Sub Code2()

Dim lRow As Long, Counter As Long, ws1 As Worksheet, ws2 As Worksheet, cell As Range, Rg As Range
Set ws1 = ActiveSheet
lRow = ws1.Range("N" & Rows.Count).End(xlUp).Row
Counter = 1

With ws1
    .Columns("P").Insert
    .Range("P25").Value = "Table Number"
End With

Set Rg = ws1.Range("N26:N" & lRow)

For Each cell In Rg
    If cell.Value = "Time" Then Counter = Counter + 1
    cell.Offset(0, 2).Value = Counter
Next

Set Rg = ws1.Range("N25:P" & lRow)

Sheets.Add After:=Sheets(Sheets.Count)
Set ws2 = Sheets(Sheets.Count)

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Rg).CreatePivotTable _
    TableDestination:=ws2.Name & "!R3C1", TableName:="PVT1"

Dim PVT1 As PivotTable
Set PVT1 = ws2.PivotTables("PVT1")

With PVT1
    .PivotFields(1).Orientation = xlRowField
    .AddDataField PVT1.PivotFields(2), "Sum of Amount", xlSum
    .PivotFields(3).Orientation = xlColumnField
End With

lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Rg = ws2.UsedRange

Cols = Rg.Columns.Count

With ws2
    .Range(ws2.Cells(lRow + 5, 1), ws2.Cells(Rg.Rows.Count + lRow + 4, Rg.Columns.Count)) = Rg.Value
    .Rows("1:" & lRow + 5).EntireRow.Delete
    .Cells(1, 1).Value = "Time"
    .Columns(Cols).EntireColumn.Delete
End With

For x = 2 To Cols - 1
    ws2.Cells(1, x).Value = "Table " & ws2.Cells(1, x).Value
Next x

lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

Dim pValue As Variant

For x = lRow To 2 Step -1
    pValue = ws2.Cells(x, 1).Value
    Select Case pValue
        Case "Time", "Total", "(blank)", "Grand Total": ws2.Rows(x).EntireRow.Delete
    End Select
Next x

ws1.Columns("P").EntireColumn.Delete

With ws2
    .UsedRange.Columns.AutoFit
    .Columns(1).NumberFormat = "h:mm AM/PM"
End With

End Sub
 
Upvote 0
Hey ksillas,

I have revamped the code completely ... I am using less sophisticated way but it this might work. Let me know how it goes

Code:
Option Compare Text

Sub Code2()

Dim lRow As Long, Counter As Long, ws1 As Worksheet, ws2 As Worksheet, cell As Range, Rg As Range
Set ws1 = ActiveSheet
lRow = ws1.Range("N" & Rows.Count).End(xlUp).Row
Counter = 1

With ws1
    .Columns("P").Insert
    .Range("P25").Value = "Table Number"
End With

Set Rg = ws1.Range("N26:N" & lRow)

For Each cell In Rg
    If cell.Value = "Time" Then Counter = Counter + 1
    cell.Offset(0, 2).Value = Counter
Next

Set Rg = ws1.Range("N25:P" & lRow)

Sheets.Add After:=Sheets(Sheets.Count)
Set ws2 = Sheets(Sheets.Count)

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Rg).CreatePivotTable _
    TableDestination:=ws2.Name & "!R3C1", TableName:="PVT1"

Dim PVT1 As PivotTable
Set PVT1 = ws2.PivotTables("PVT1")

With PVT1
    .PivotFields(1).Orientation = xlRowField
    .AddDataField PVT1.PivotFields(2), "Sum of Amount", xlSum
    .PivotFields(3).Orientation = xlColumnField
End With

lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Rg = ws2.UsedRange

Cols = Rg.Columns.Count

With ws2
    .Range(ws2.Cells(lRow + 5, 1), ws2.Cells(Rg.Rows.Count + lRow + 4, Rg.Columns.Count)) = Rg.Value
    .Rows("1:" & lRow + 5).EntireRow.Delete
    .Cells(1, 1).Value = "Time"
    .Columns(Cols).EntireColumn.Delete
End With

For x = 2 To Cols - 1
    ws2.Cells(1, x).Value = "Table " & ws2.Cells(1, x).Value
Next x

lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

Dim pValue As Variant

For x = lRow To 2 Step -1
    pValue = ws2.Cells(x, 1).Value
    Select Case pValue
        Case "Time", "Total", "(blank)", "Grand Total": ws2.Rows(x).EntireRow.Delete
    End Select
Next x

ws1.Columns("P").EntireColumn.Delete

With ws2
    .UsedRange.Columns.AutoFit
    .Columns(1).NumberFormat = "h:mm AM/PM"
End With

End Sub

This works!!! As per your instructions, I replaced "Time" with "Hora" (Since the file is in spanish, for anyone curious!).

Thank you so much!
 
Upvote 0

Forum statistics

Threads
1,224,825
Messages
6,181,189
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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