VBA Loop through Column

K

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.

time (col n)amount (col o)
5:00 AM1542
5:30 AM2345
......
11:00 PM4454

<tbody>
</tbody>


<graph here="">GRAPH HERE
</graph>
​
<graph here="">
time (col n)amount (col o)
5:30 AM1541
......
11:00 PM4242
11:30 PM5356

<tbody>
</tbody>


<graph here="">GRAPH HERE
</graph>
​
<graph here="">
time (col n)amount (col o)
4:30 AM7445
5:00 AM4521
......
11:30 AM4547

<tbody>
</tbody>

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:

Time1st table2nd table3rd table
5:30 AM154215417445
6:00 AM242532546242
............
11:30 AM445453564547

<tbody>
</tbody>

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

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
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
mse330 said:
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?
Click to expand...

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
NO
25TimeAmount
264:30 AM1
275:00 AM10
285:30 AM11
296:00 AM482
306:30 AM861
317:00 AM1,100
327:30 AM1,219
338:00 AM1,037
348:30 AM1,099
359:00 AM1,086
369:30 AM1,001
3710:00 AM1,074
3810:30 AM1,135
3911:00 AM1,016
4011:30 AM996
4112:00 PM924
4212:30 PM1,072
431:00 PM1,112
441:30 PM1,324
452:00 PM1,430
462:30 PM1,389
473:00 PM1,332
483:30 PM1,480
494:00 PM1,426
504:30 PM1,508
515:00 PM1,516
525:30 PM1,649
536:00 PM1,566
546:30 PM1,772
557:00 PM1,606
567:30 PM1,574
578:00 PM1,455
588:30 PM1,317
599:00 PM991
609:30 PM860
6110:00 PM343
6210:30 PM18
6311:00 PM3
6411:30 PM1
65Total39796

<tbody>
</tbody>
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
A
1Time
212:00 AM
312:30 AM
41:00 AM
51:30 AM
62:00 AM
72:30 AM
83:30 AM
94:00 AM
104:30 AM
115:00 AM
125:30 AM
136:00 AM
146:30 AM
157:00 AM
167:30 AM
178:00 AM
188:30 AM
199:00 AM
209:30 AM
2110:00 AM
2210:30 AM
2311:00 AM
2411:30 AM
2512:00 PM
2612:30 PM
271:00 PM
281:30 PM
292:00 PM
302:30 PM
313:00 PM
323:30 PM
334:00 PM
344:30 PM
355:00 PM
365:30 PM
376:00 PM
386:30 PM
397:00 PM
407:30 PM
418:00 PM
428:30 PM
439:00 PM
449:30 PM
4510:00 PM
4610:30 PM
4711:00 PM
4811:30 PM
49Time
50Total

<tbody>
</tbody>
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
mse330 said:
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
Click to expand...

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
Glad I could help & thanks for reporting back :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
Formula to find 'Part of the Day' from the Time Column
Replies
8
Views
311
Zee996
Z
L
  • Question
IF statement for Time Ranges
Replies
1
Views
379
awoohaw
awoohaw
C
  • Solved
Convert and copy to Date
Replies
5
Views
120
Micron
M
N
  • Question
2-step Dynamic Ranges and Charts
Replies
0
Views
225
Nick Loughton
N
C
  • Question
Ordinary Hours or Penalty Shift
Replies
0
Views
91
ChetanPuri
C

Forum statistics

Threads
1,215,212
Messages
6,123,653
Members
449,111
Latest member
ghennedy

Share this page

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