VBA Loop

M

MOXY1975

New Member
Joined
Apr 25, 2013
Messages
26
I have a large dataset comprising of hourly information across 2 years.

Using DAverage / Dmax etc, I am able to lookup specific month / hour and see results.

I want to write a macro that runs each month / hour iteration (note that the year is no matter to me as I am seeking average data by month) and pastes it into a table which has monthly columns and hourly data.

I have tried recording in longform but VBA says that the procedure is too large (makes sense, 12 months * 24 hours = 288 iterations)

I recall someone telling me of a way to run a macro that basically says for each month in the year (i.e. 1-12) and hour in the day (0 - 23) repeat the following task and paste it into a table.

For now I have split the macro in two: (example of January and February below for reference) and run them sequentially.

Any ideas much appreciated:

Hourly_Table Macro
'
' January
Range("B3").Select
Application.Goto Reference:="Month"
ActiveCell.FormulaR1C1 = "1"

' 00:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "0"
Range("D3").Select
Selection.Copy
Range("L24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 01:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "1"
Range("D3").Select
Selection.Copy
Range("L25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 02:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "2"
Range("D3").Select
Selection.Copy
Range("L26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 03:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "3"
Range("D3").Select
Selection.Copy
Range("L27").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 04:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "4"
Range("D3").Select
Selection.Copy
Range("L28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 05:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "5"
Range("D3").Select
Selection.Copy
Range("L29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 06:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "6"
Range("D3").Select
Selection.Copy
Range("L30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 07:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "7"
Range("D3").Select
Selection.Copy
Range("L31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 08:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "8"
Range("D3").Select
Selection.Copy
Range("L32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 09:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "9"
Range("D3").Select
Selection.Copy
Range("L33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' 10:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "10"
Range("D3").Select
Selection.Copy
Range("L34").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 11:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "11"
Range("D3").Select
Selection.Copy
Range("L35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 12:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "12"
Range("D3").Select
Selection.Copy
Range("L36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 13:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "13"
Range("D3").Select
Selection.Copy
Range("L37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' 14:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "14"
Range("D3").Select
Selection.Copy
Range("L38").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 15:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "15"
Range("D3").Select
Selection.Copy
Range("L39").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 16:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "16"
Range("D3").Select
Selection.Copy
Range("L40").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 17:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "17"
Range("D3").Select
Selection.Copy
Range("L41").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 18:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "18"
Range("D3").Select
Selection.Copy
Range("L42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 19:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "19"
Range("D3").Select
Selection.Copy
Range("L43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 20:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "20"
Range("D3").Select
Selection.Copy
Range("L44").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 21:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "21"
Range("D3").Select
Selection.Copy
Range("L45").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 22:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "22"
Range("D3").Select
Selection.Copy
Range("L46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 23:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "23"
Range("D3").Select
Selection.Copy
Range("L47").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' February
Range("B3").Select
Application.Goto Reference:="Month"
ActiveCell.FormulaR1C1 = "2"

' 00:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "0"
Range("D3").Select
Selection.Copy
Range("M24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 01:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "1"
Range("D3").Select
Selection.Copy
Range("M25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 02:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "2"
Range("D3").Select
Selection.Copy
Range("M26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 03:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "3"
Range("D3").Select
Selection.Copy
Range("M27").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 04:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "4"
Range("D3").Select
Selection.Copy
Range("M28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 05:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "5"
Range("D3").Select
Selection.Copy
Range("M29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 06:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "6"
Range("D3").Select
Selection.Copy
Range("M30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 07:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "7"
Range("D3").Select
Selection.Copy
Range("M31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 08:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "8"
Range("D3").Select
Selection.Copy
Range("M32").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 09:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "9"
Range("D3").Select
Selection.Copy
Range("M33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' 10:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "10"
Range("D3").Select
Selection.Copy
Range("M34").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 11:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "11"
Range("D3").Select
Selection.Copy
Range("M35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 12:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "12"
Range("D3").Select
Selection.Copy
Range("M36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 13:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "13"
Range("D3").Select
Selection.Copy
Range("M37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' 14:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "14"
Range("D3").Select
Selection.Copy
Range("M38").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 15:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "15"
Range("D3").Select
Selection.Copy
Range("M39").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 16:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "16"
Range("D3").Select
Selection.Copy
Range("M40").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 17:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "17"
Range("D3").Select
Selection.Copy
Range("M41").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 18:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "18"
Range("D3").Select
Selection.Copy
Range("M42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 19:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "19"
Range("D3").Select
Selection.Copy
Range("M43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 20:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "20"
Range("D3").Select
Selection.Copy
Range("M44").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 21:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "21"
Range("D3").Select
Selection.Copy
Range("M45").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 22:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "22"
Range("D3").Select
Selection.Copy
Range("M46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' 23:00
Application.Goto Reference:="Time_Start"
ActiveCell.FormulaR1C1 = "23"
Range("D3").Select
Selection.Copy
Range("M47").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 

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
Sort by date Sort by votes
do you need the results on the same sheet as the source data?

I would add a new sheet to put it on. I used your code as a basis but I have no way to test this. Try this:

Code: 
Sub hourlyRates()
Dim currCol As Integer
Dim currRow As Long
Dim sourceSheet As Worksheet
Dim destSheet As Worksheet


Set sourceSheet = Sheets(ActiveSheet.Name)


Set destSheet = Sheets.Add(after:=sourceSheet)
destSheet.Name = "Hourly Rates"


sourceSheet.Activate
For currCol = 2 To 13
    destSheet.Cells(1, currCol) = Format(DateSerial(2013, currCol - 1, 1), "MMMM")
    Application.Goto Reference:="Month"
    ActiveCell.Value = currCol-1
    For currRow = 2 To 25
        If (destSheet.Cells(currRow, 1) = "") Then
            destSheet.Cells(currRow, 1) = TimeSerial(currRow - 1, 0, 0)
            destSheet.Cells(currRow, 1).NumberFormat = "hh:mm"
        End If
        Application.Goto Reference:="Time_Start"
        ActiveCell.Value = currRow-2
        destSheet.Cells(currRow, currCol).Value = Cells(3, 4).Value
    Next
Next
End Sub
 
Upvote 0
It worked a treat - many thanks.

I adjusted slightly to paste the table to an existing sheet as follows:

Sub hourlyratestest()
'
' test Macro
'
Dim currCol As Integer
Dim currRow As Long
Dim sourceSheet As Worksheet
Dim destSheet As Worksheet

Set sourceSheet = Sheets("Raw Data Normalized")
Set destSheet = Sheets("Hourly Rates")
sourceSheet.Activate
For currCol = 2 To 13
destSheet.Cells(1, currCol) = Format(DateSerial(2013, currCol - 1, 1), "MMMM")
Application.Goto Reference:="Month"
ActiveCell.Value = currCol - 1
For currRow = 2 To 25
If (destSheet.Cells(currRow, 1) = "") Then
destSheet.Cells(currRow, 1) = TimeSerial(currRow - 1, 0, 0)
destSheet.Cells(currRow, 1).NumberFormat = "hh:mm"
End If
Application.Goto Reference:="Time_Start"
ActiveCell.Value = currRow - 2
destSheet.Cells(currRow, currCol).Value = Cells(4, 4).Value
Next
Next
End Sub

Many thanks
 
Upvote 0
Thanks for the feed back. Glad it helped.

It is good to post your final code so it can help somebody else.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
197
Possum17
P
D
  • Question
VBA optimization advice
Replies
3
Views
98
bobsan42
bobsan42
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
308
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
173
pennbowl
P
P
  • Question
Help with Vba Code
Replies
3
Views
160
Coyotex3
C

Forum statistics

Threads
1,214,976
Messages
6,122,539
Members
449,088
Latest member
RandomExceller01

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