Adding a loop to a recorded macro

H

hweih

New Member
Joined
Apr 10, 2018
Messages
4
Hello all,

I recorded a macro that correlates a price series against an ascending sequence of numbers. The key steps are:

1) populate the adjacent column with ascending numbers i.e. 1,2,3,4,5...
2) Use the correl function to find the correlation between the price and the ascending numbers. A rolling interval of 5 rows was used in this case.
3) Use the data analysis toolpak to plot a histogram showing the % frequency of each bin in the correlation range of -1 to +1.

Unfortunately this macro will not work on any price series that has fewer rows than the original one. I probably need a sort of loop function that continues the process until the price data runs out. Could anyone please provide some guidance on how to implement this loop?


Code: 
Sub correlation()'
' correlation Macro
'


'
    ActiveCell.FormulaR1C1 = "1"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("C2:C4").Select
    Selection.AutoFill Destination:=Range("C2:C101"), Type:=xlFillDefault
    Range("C2:C101").Select
    ActiveWindow.SmallScroll Down:=-87
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "=CORREL(R[-4]C[-2]:RC[-2],R[-4]C[-1]:RC[-1])"
    Range("D6").Select
    Selection.AutoFill Destination:=Range("D6:D101"), Type:=xlFillDefault
    Range("D6:D101").Select
    ActiveWindow.SmallScroll Down:=-102
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "-1"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "-0.95"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "-0.9"
    Range("F2:F4").Select
    Selection.AutoFill Destination:=Range("F2:F43"), Type:=xlFillDefault
    Range("F2:F43").Select
    ActiveWindow.SmallScroll Down:=-57
    Range("H2").Select
     Application.Run "ATPVBAEN.XLAM!Histogram", ActiveSheet.Range("$D$6:$D$101") _
        , ActiveSheet.Range("$H$2"), ActiveSheet.Range("$F$2:$F$43"), False, False _
        , True, False
    ActiveSheet.Shapes(1).ScaleWidth 2.6614583333, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes(1).ScaleHeight 2.705, msoFalse, msoScaleFromTopLeft
    Range("I3").Select
    ActiveWindow.SmallScroll Down:=21
    Range("H45").Select
    Selection.ClearContents
    Range("I45").Select
    Selection.ClearContents
    Range("I46").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"
    Range("I47").Select
    ActiveWindow.SmallScroll Down:=-39
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/R46C9*100"
    Range("J3").Select
    Selection.AutoFill Destination:=Range("J3:J44"), Type:=xlFillDefault
    Range("J3:J44").Select
    ActiveWindow.SmallScroll Down:=-30
    ActiveSheet.ChartObjects(1).Activate
    ActiveChart.PlotArea.Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).Values = "=Sheet1!$J$3:$J$44"
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).AxisBetweenCategories = False
    Application.CommandBars("Format Object").Visible = False
    Range("Q38").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("L32").Select
    ActiveCell.FormulaR1C1 = "0.7"
    Range("L33").Select
    ActiveCell.FormulaR1C1 = "-0.7"
    Range("L32:M33").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("M32").Select
    ActiveWindow.SmallScroll Down:=-9
    ActiveCell.FormulaR1C1 = "=SUM(R[-28]C[-3]:R[-23]C[-3])"
    Range("M33").Select
    ActiveWindow.SmallScroll Down:=12
    ActiveCell.FormulaR1C1 = "=SUM(R[5]C[-3]:R[10]C[-3])"
    Range("M34").Select
    ActiveWindow.SmallScroll Down:=-51
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Hello.

You don't need a loop. Calculate where the last row of the pricelist is and incorporate that row number in the appropriate ranges. See the code below.
note: I also streamlined the code, because in a recorded macro there are always constructs with select <range> followed by selection..<something> or activecel..<something>, which I replaced with <range>.<something>

Code: 
Sub correlation2()
    Dim lastRow
    
    With ActiveSheet
        lastRow = .Range("B2").End(xlDown).Row
        
        .Range("C:D").Clear
        .Range("C2").FormulaR1C1 = "1"
        .Range("C3").FormulaR1C1 = "2"
        .Range("C4").FormulaR1C1 = "3"
        .Range("C2:C4").AutoFill Destination:=Range("C2:C" & lastRow), Type:=xlFillDefault
        
        .Range("D6").FormulaR1C1 = "=CORREL(R[-4]C[-2]:RC[-2],R[-4]C[-1]:RC[-1])"
        .Range("D6").AutoFill Destination:=Range("D6:D" & lastRow), Type:=xlFillDefault
        
        .Range("F2").FormulaR1C1 = "-1"
        .Range("F3").FormulaR1C1 = "-0.95"
        .Range("F4").FormulaR1C1 = "-0.9"
        .Range("F2:F4").AutoFill Destination:=Range("F2:F43"), Type:=xlFillDefault
         
         .Range("H:J").Clear: If .ChartObjects.Count > 0 Then .ChartObjects(1).Delete
         Application.Run "ATPVBAEN.XLAM!Histogram", .Range("$D$6:$D$" & lastRow) _
            , .Range("$H$2"), .Range("$F$2:$F$43"), False, False _
            , True, False
        .Shapes(1).Top = 5
        .Shapes(1).ScaleWidth 2.6614583333, msoFalse, msoScaleFromTopLeft
        .Shapes(1).ScaleHeight 2.705, msoFalse, msoScaleFromTopLeft
        
        .Range("H45").ClearContents
        .Range("I45").ClearContents
        .Range("I46").FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"
        
        .Range("J3").FormulaR1C1 = "=RC[-1]/R46C9*100"
        .Range("J3").AutoFill Destination:=Range("J3:J44"), Type:=xlFillDefault
        
        .ChartObjects(1).Activate
        With ActiveChart
          'why?  .FullSeriesCollection(1).Values = "=Sheet1!$J$3:$J$44"
            .Axes(xlCategory).Select
            .Axes(xlCategory).AxisBetweenCategories = False
        End With
        
        Application.CommandBars("Format Object").Visible = False
        
        .Range("L32").FormulaR1C1 = "0.7"
        .Range("L33").FormulaR1C1 = "-0.7"
        
        With .Range("L32:M33").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        .Range("L32:M33").Font.Bold = True
        
        .Range("M32").FormulaR1C1 = "=SUM(R[-28]C[-3]:R[-23]C[-3])"
        .Range("M33").FormulaR1C1 = "=SUM(R[5]C[-3]:R[10]C[-3])"
    End With
End Sub
 
Upvote 0
ask2tsp said:
Hello.

You don't need a loop. Calculate where the last row of the pricelist is and incorporate that row number in the appropriate ranges. See the code below.
note: I also streamlined the code, because in a recorded macro there are always constructs with select <range> followed by selection..<something> or activecel..<something>, which I replaced with <range>.<something>

Code: 
Sub correlation2()
    Dim lastRow
    
    With ActiveSheet
        lastRow = .Range("B2").End(xlDown).Row
        
        .Range("C:D").Clear
        .Range("C2").FormulaR1C1 = "1"
        .Range("C3").FormulaR1C1 = "2"
        .Range("C4").FormulaR1C1 = "3"
        .Range("C2:C4").AutoFill Destination:=Range("C2:C" & lastRow), Type:=xlFillDefault
        
        .Range("D6").FormulaR1C1 = "=CORREL(R[-4]C[-2]:RC[-2],R[-4]C[-1]:RC[-1])"
        .Range("D6").AutoFill Destination:=Range("D6:D" & lastRow), Type:=xlFillDefault
        
        .Range("F2").FormulaR1C1 = "-1"
        .Range("F3").FormulaR1C1 = "-0.95"
        .Range("F4").FormulaR1C1 = "-0.9"
        .Range("F2:F4").AutoFill Destination:=Range("F2:F43"), Type:=xlFillDefault
         
         .Range("H:J").Clear: If .ChartObjects.Count > 0 Then .ChartObjects(1).Delete
         Application.Run "ATPVBAEN.XLAM!Histogram", .Range("$D$6:$D$" & lastRow) _
            , .Range("$H$2"), .Range("$F$2:$F$43"), False, False _
            , True, False
        .Shapes(1).Top = 5
        .Shapes(1).ScaleWidth 2.6614583333, msoFalse, msoScaleFromTopLeft
        .Shapes(1).ScaleHeight 2.705, msoFalse, msoScaleFromTopLeft
        
        .Range("H45").ClearContents
        .Range("I45").ClearContents
        .Range("I46").FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"
        
        .Range("J3").FormulaR1C1 = "=RC[-1]/R46C9*100"
        .Range("J3").AutoFill Destination:=Range("J3:J44"), Type:=xlFillDefault
        
        .ChartObjects(1).Activate
        With ActiveChart
          'why?  .FullSeriesCollection(1).Values = "=Sheet1!$J$3:$J$44"
            .Axes(xlCategory).Select
            .Axes(xlCategory).AxisBetweenCategories = False
        End With
        
        Application.CommandBars("Format Object").Visible = False
        
        .Range("L32").FormulaR1C1 = "0.7"
        .Range("L33").FormulaR1C1 = "-0.7"
        
        With .Range("L32:M33").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        .Range("L32:M33").Font.Bold = True
        
        .Range("M32").FormulaR1C1 = "=SUM(R[-28]C[-3]:R[-23]C[-3])"
        .Range("M33").FormulaR1C1 = "=SUM(R[5]C[-3]:R[10]C[-3])"
    End With
End Sub
Click to expand...

Hello ask2tsp,

Thank you for your kind help. Unfortunately I am still new to VBA. Which part of the code do I input the last row number?

</something></range></something></something></range>
 
Upvote 0
Not to speak for anyone, or speak out of turn, but the code given looks for the last used row in column B by itself. You don't have to input anything.
 
Upvote 0
Please just run the macro and see what happens. Then use a shorter or longer pricelist and run the macro again.
 
Upvote 0
ask2tsp said:
Please just run the macro and see what happens. Then use a shorter or longer pricelist and run the macro again.
Click to expand...

Thank you! The macro runs perfectly when I change the length of the price list. The only difference is the histogram vertical axis now shows the absolute frequency instead of the % value.

And if I wish to change the number of periods used in the correlation calculation, I only need to change the following line right?

Code: 
Range("D6").FormulaR1C1 = "=CORREL(R[-4]C[-2]:RC[-2],R[-4]C[-1]:RC[-1])"
 
Upvote 0
The only difference is the histogram vertical axis now shows the absolute frequency instead of the % value.
Click to expand...
Fixed that.

And if I wish to change the number of periods used in the correlation calculation
Click to expand...
Changed the code so you enter the number of periods on the sheet in cell B1. No more changing the code.
Code: 
Sub correlation2()
    Dim lastRow As Long, runLength As Long, correlStart As Range
    
    With ActiveSheet
        lastRow = .Range("B2").End(xlDown).Row
        runLength = .Range("B1"): Set correlStart = .Cells(1 + runLength, 4)
        
        .Range("C:D").Clear
        .Range("C2") = 1
        .Range("C3") = 2
        .Range("C4") = 3
        .Range("C2:C4").AutoFill Destination:=Range("C2:C" & lastRow), Type:=xlFillDefault

        correlStart.Formula = _
        "=CORREL(" & Range(Cells(correlStart.Row - runLength + 1, 2), Cells(correlStart.Row, 2)).Address(0, 0) & _
               "," & Range(Cells(correlStart.Row - runLength + 1, 3), Cells(correlStart.Row, 3)).Address(0, 0) & ")"
        correlStart.AutoFill Destination:=Range(correlStart, "D" & lastRow), Type:=xlFillDefault
        
        .Range("F2").FormulaR1C1 = "-1"
        .Range("F3").FormulaR1C1 = "-0.95"
        .Range("F4").FormulaR1C1 = "-0.9"
        .Range("F2:F4").AutoFill Destination:=Range("F2:F43"), Type:=xlFillDefault
         
         .Range("H:J").Clear: If .ChartObjects.Count > 0 Then .ChartObjects(1).Delete
         Application.Run "ATPVBAEN.XLAM!Histogram", .Range("$D$6:$D$" & lastRow) _
            , .Range("$H$2"), .Range("$F$2:$F$43"), False, False _
            , True, False
        .Shapes(1).Top = 5
        .Shapes(1).ScaleWidth 2.6614583333, msoFalse, msoScaleFromTopLeft
        .Shapes(1).ScaleHeight 2.705, msoFalse, msoScaleFromTopLeft
        
        .Range("H45").ClearContents
        .Range("I45").ClearContents
        .Range("I46").FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"
        
        .Range("J3").FormulaR1C1 = "=RC[-1]/R46C9*100"
        .Range("J3").AutoFill Destination:=Range("J3:J44"), Type:=xlFillDefault
        
        .ChartObjects(1).Activate
        With ActiveChart
            .FullSeriesCollection(1).Values = "=Sheet1!$J$3:$J$44"
            .Axes(xlCategory).Select
            .Axes(xlCategory).AxisBetweenCategories = False
        End With
        
        Application.CommandBars("Format Object").Visible = False
        
        .Range("L32").FormulaR1C1 = "0.7"
        .Range("L33").FormulaR1C1 = "-0.7"
        
        With .Range("L32:M33").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        .Range("L32:M33").Font.Bold = True
        
        .Range("M32").FormulaR1C1 = "=SUM(R[-28]C[-3]:R[-23]C[-3])"
        .Range("M33").FormulaR1C1 = "=SUM(R[5]C[-3]:R[10]C[-3])"
    End With
End Sub
 
Upvote 0
ask2tsp said:
Fixed that.


Changed the code so you enter the number of periods on the sheet in cell B1. No more changing the code.
Code: 
Sub correlation2()
    Dim lastRow As Long, runLength As Long, correlStart As Range
    
    With ActiveSheet
        lastRow = .Range("B2").End(xlDown).Row
        runLength = .Range("B1"): Set correlStart = .Cells(1 + runLength, 4)
        
        .Range("C:D").Clear
        .Range("C2") = 1
        .Range("C3") = 2
        .Range("C4") = 3
        .Range("C2:C4").AutoFill Destination:=Range("C2:C" & lastRow), Type:=xlFillDefault

        correlStart.Formula = _
        "=CORREL(" & Range(Cells(correlStart.Row - runLength + 1, 2), Cells(correlStart.Row, 2)).Address(0, 0) & _
               "," & Range(Cells(correlStart.Row - runLength + 1, 3), Cells(correlStart.Row, 3)).Address(0, 0) & ")"
        correlStart.AutoFill Destination:=Range(correlStart, "D" & lastRow), Type:=xlFillDefault
        
        .Range("F2").FormulaR1C1 = "-1"
        .Range("F3").FormulaR1C1 = "-0.95"
        .Range("F4").FormulaR1C1 = "-0.9"
        .Range("F2:F4").AutoFill Destination:=Range("F2:F43"), Type:=xlFillDefault
         
         .Range("H:J").Clear: If .ChartObjects.Count > 0 Then .ChartObjects(1).Delete
         Application.Run "ATPVBAEN.XLAM!Histogram", .Range("$D$6:$D$" & lastRow) _
            , .Range("$H$2"), .Range("$F$2:$F$43"), False, False _
            , True, False
        .Shapes(1).Top = 5
        .Shapes(1).ScaleWidth 2.6614583333, msoFalse, msoScaleFromTopLeft
        .Shapes(1).ScaleHeight 2.705, msoFalse, msoScaleFromTopLeft
        
        .Range("H45").ClearContents
        .Range("I45").ClearContents
        .Range("I46").FormulaR1C1 = "=SUM(R[-43]C:R[-2]C)"
        
        .Range("J3").FormulaR1C1 = "=RC[-1]/R46C9*100"
        .Range("J3").AutoFill Destination:=Range("J3:J44"), Type:=xlFillDefault
        
        .ChartObjects(1).Activate
        With ActiveChart
            .FullSeriesCollection(1).Values = "=Sheet1!$J$3:$J$44"
            .Axes(xlCategory).Select
            .Axes(xlCategory).AxisBetweenCategories = False
        End With
        
        Application.CommandBars("Format Object").Visible = False
        
        .Range("L32").FormulaR1C1 = "0.7"
        .Range("L33").FormulaR1C1 = "-0.7"
        
        With .Range("L32:M33").Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        
        .Range("L32:M33").Font.Bold = True
        
        .Range("M32").FormulaR1C1 = "=SUM(R[-28]C[-3]:R[-23]C[-3])"
        .Range("M33").FormulaR1C1 = "=SUM(R[5]C[-3]:R[10]C[-3])"
    End With
End Sub
Click to expand...

Thank you so much for your kind help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
410
Sean15
Sean15
T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
335
RoryA
RoryA
P
  • Question Question
Help with Vba Code
Replies
3
Views
433
Coyotex3
C
C
  • Question Question
Loop/Repeat Macro
2
Replies
11
Views
703
kvsrinivasamurthy
K
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
2K
Joe4
Joe4

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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