Macro not working as expected

[bknight]

Code: Select all

Sub Test()
Set ws = ActiveWorksheet
'cl = Column reference to determine length of (eg: "A")
'lr = Last cell of above column

lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
End Sub

No declaration that I can find

[HansV]

Add the following below the line Sub Test():

Dim ws As Worksheet

[bknight]

Code: Select all

Sub Test()
Dim ws As Worksheet
Set ws = Worksheets("sheet2")
'cl = Column reference to determine length of (eg: "A")
'lr = Last cell of above column
lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
End Sub

Works
While I'm at it the create macro is greyed out and I search throughout the options but haven't found where to apply.

[HansV]

What do you mean by "the create macro is greyed out"?

[bknight]

Well if I select macros in the ribbon there is
1. View
2. Record
3. Use Relative references
Selecting the View option
1. Run
2. Step into
3. Edit
4. Create -->BUT it is greyed out
5. Delete
6. Options

[bknight]

Using Alan's code, have a look at this and see if
1. Contains errors"
2. Will copy the rows, without the time errors noted by both him and I?

Code: Select all

Sub CopyCellsFormulas()
    Dim dteDateValue As Date
    Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    Dim ws As Worksheet
    Const defName As String = "DataCol"
    Const defNameOEX_High As String = "OEX_High"
    Const defNameOEX_Low As String = "OEX_Low"
    Const defNameDATE_Range As String = "DATE_Range"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set ws = Worksheets("Vix")
    Worksheets("Vix").Activate
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngVix As Range 
    Set rngVix = Worksheets("Vix").Range("F" & I - 1 & ":I" & lr + 1 & "")
    Dim arrrngVix() As Variant 
    Let arrrngVix() = rngVix.Formula 
    Dim Cntrw As Long, Cntclm As Long
        For Cntrw = 1 To (UBound(arrrngVix(), 1) - 1) 
            For Cntclm = 1 To UBound(arrrngVix(), 2)
            Let arrrngVix(Cntrw + 1, Cntclm) = arrrngVix(Cntrw, Cntclm) 
            Next Cntclm
        Next Cntrw
    Let rngVix.Value = arrrngVix() ' This will paste out the Formula values back to the Worksheet
    Cells(I, 2).Select
    I = intStartRow
    Worksheets("PutCall Ratio").Activate
    Set ws = Worksheets("Put Call Ratio")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngPutCall As Range 
    Set rngPutCall = Worksheets("PutCall Ratio").Range("F" & I - 1 & ":H" & lr + 1 & "")
    Dim arrrngPutCall() As Variant 
    Let arrrngPutCall() = rngPutCall.Formula 
    Dim Cntrw As Long, Cntclm As Long
        For Cntrw = 1 To (UBound(arrrngPutCall(), 1) - 1)
            For Cntclm = 1 To UBound(arrrngPutCall(), 2) 
            Let arrrngPutCall(Cntrw + 1, Cntclm) = arrrngPutCall(Cntrw, Cntclm) 
            Next Cntclm
        Next Cntrw
    Let rngPutCall.Value = arrrngPutCall() 
    Cells(I, 2).Select
    I = lr - 22
    Do
        dbl9Value = 0: dbl21Value = 0
        For J = I To (I - 20) Step -1
            dbl21Value = Cells(J, 5) + dbl21Value
        Next J
        For J = I To (I - 8) Step -1
            dbl9Value = Cells(J, 5) + dbl9Value
        Next J
        If I > 9 Then Cells(I, 11) = dbl9Value / 9
        If I > 20 Then Cells(I, 12) = dbl21Value / 21
        Cells(I, 11).NumberFormat = "0.00": Cells(I, 12).NumberFormat = "0.00"
        I = I + 1
    Loop Until Cells(I, 1) > Now() Or Cells(I, 2) = ""
    Cells(I, 2).Select
    I = intStartRow
    Worksheets("OEX").Activate
    Set ws = Worksheets("OEX")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngOex As Range 
    Set rngOex = Worksheets("Oex").Range("F" & I - 1 & ":I" & lr + 1 & "")
    Dim arrrngOex() As Variant 
    Let arrrngOex() = rngOex.Formula 
    Dim Cntrw As Long, Cntclm As Long
        For Cntrw = 1 To (UBound(arrrngOex(), 1) - 1 ' at every "row" in the Array, (Up to the one before the last),  we ...
            For Cntclm = 1 To UBound(arrrngOex(), 2) 
                Let arrrngOex(Cntrw + 1, Cntclm) = arrrngOex(Cntrw, Cntclm) 
            Next Cntclm
        Next Cntrw
    Let rngOex.Value = arrrngOex() 
    Cells(I, 3).Select
    R = Cells(Rows.Count, "D").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="=" & ActiveSheet.Name & "!" & Range("D2", Cells(R + 1, "D")).Address
    R = Cells(Rows.Count, "E").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="=" & ActiveSheet.Name & "!" & Range("E2", Cells(R + 1, "E")).Address
    R = Cells(Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="=" & ActiveSheet.Name & "!" & Range("A2", Cells(R + 1, "A")).Address
    Worksheets("Calc").Activate
    Set ws = Worksheets("Calc")
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim rngCalc As Range
    Set rngCalc = Worksheets("Calc").Range("F" & I - 1 & ":I" & lr + 1 & "")
    Dim arrrngCalc() As Variant
    Let arrrngCalc() = rngCalc.Formula 
    Dim Cntrw As Long, Cntclm As Long
        For Cntrw = 1 To (UBound(arrrngCalc(), 1) - 1) 
            For Cntclm = 1 To UBound(arrrngCalc(), 2)
                Let arrrngCalc(Cntrw + 1, Cntclm) = arrrngCalc(Cntrw, Cntclm)
            Next Cntclm
        Next Cntrw
    Let rngCalc.Value = arrrngCalc() ' This will paste out the Formula values back to the Worksheet    Cells(I + 1, 2).Select
    R = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[HansV]

Selecting the View option
1. Run
2. Step into
3. Edit
4. Create -->BUT it is greyed out
5. Delete
6. Options

The Create button will be enabled when you enter a new name in the 'Macro name' box:

S1389.png

[HansV]

It's difficult to comprehend the code, but I notice several problems:

1) You use the variable I before having assigned a value to it, so it will be 0 (the default value of an Integer). I - 1 = -1 is not a valid row number.
2) You use the variable intStartRow before having assigned a value to it, so it will be 0.
3) You refer to Worksheets("Put Call Ratio") and to Worksheets("PutCall Ratio"). Only one of these is correct.
4) You create formulas that refer to sheets with spaces in their name without enclosing the sheet name in apostrophes.

I have no idea whether the following will do what you want, but it compiles without error and is more consistent.
Look for the comments with ??? and assign appropriate values to the variable I.

Code: Select all

Sub CopyCellsFormulas()
    Dim dteDateValue As Date
    Dim I As Integer, J As Integer, intStartRow As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    Dim ws As Worksheet
    Dim lr As Long
    Dim rng As Range
    Dim arr() As Variant
    Dim Cntrw As Long, Cntclm As Long
    Const defName As String = "DataCol"
    Const defNameOEX_High As String = "OEX_High"
    Const defNameOEX_Low As String = "OEX_Low"
    Const defNameDATE_Range As String = "DATE_Range"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set ws = Worksheets("Vix")
    I = 2 ' ??? What is the first row
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
        Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr() ' This will paste out the Formula values back to the Worksheet

    I = intStartRow ' ???
    Set ws = Worksheets("Put Call Ratio")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":H" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
        Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr()

    I = lr - 22 ' ???
    Do
        dbl9Value = 0: dbl21Value = 0
        For J = I To (I - 20) Step -1
            dbl21Value = ws.Cells(J, 5) + dbl21Value
        Next J
        For J = I To (I - 8) Step -1
            dbl9Value = ws.Cells(J, 5) + dbl9Value
        Next J
        If I > 9 Then ws.Cells(I, 11) = dbl9Value / 9
        If I > 20 Then ws.Cells(I, 12) = dbl21Value / 21
        ws.Cells(I, 11).NumberFormat = "0.00"
        ws.Cells(I, 12).NumberFormat = "0.00"
        I = I + 1
    Loop Until ws.Cells(I, 1) > Now() Or ws.Cells(I, 2) = ""

    I = intStartRow ' ???
    Set ws = Worksheets("OEX")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To UBound(arr(), 1) - 1
        For Cntclm = 1 To UBound(arr(), 2)
            Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr()

    lr = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="='" & ws.Name & "'!$D$2:$D$" & (lr + 1)
    lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="='" & ws.Name & "'!$E$2:$E$" & (lr + 1)
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="='" & ws.Name & "'!$A$2:$A$" & (lr + 1)

    I = 2 ' ??? What is the first row?
    Set ws = Worksheets("Calc")
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
            Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr() ' This will paste out the Formula values back to the Worksheet

    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defName, RefersTo:="='" & ws.Name & "'!$B$2:$B$" & (lr + 1)

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Code: Select all

[Doc.AElstein]

Hi bknight

.......

Will the range copying formula work when the last row in the range has no formulas, I've never used this type of copying and am ignorant?

Do you set the range containing blank rows(where formulas will go)?

I am sorry but the way you are using Quotes in the Post is totally confusing me.
I am unable to understand what you are asking
Sorry

I think I understand approximately what you are doing. But only approximately. I am still not totally clear what it is you are trying to do.

Alan

[bknight]

It's difficult to comprehend the code, but I notice several problems:

1) You use the variable I before having assigned a value to it, so it will be 0 (the default value of an Integer). I - 1 = -1 is not a valid row number.

I may not be needed now.

2) You use the variable intStartRow before having assigned a value to it, so it will be 0.

lr should replace IntStartRow

3) You refer to Worksheets("Put Call Ratio") and to Worksheets("PutCall Ratio"). Only one of these is correct.

I will fix them, good eye

4) You create formulas that refer to sheets with spaces in their name without enclosing the sheet name in apostrophes.

Some may have been variables, but I will check

I have no idea whether the following will do what you want, but it compiles without error and is more consistent.
Look for the comments with ??? and assign appropriate values to the variable I.

Code: Select all

Sub CopyCellsFormulas()
    Dim dteDateValue As Date
    Dim I As Integer, J As Integer, intStartRow As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    Dim ws As Worksheet
    Dim lr As Long
    Dim rng As Range
    Dim arr() As Variant
    Dim Cntrw As Long, Cntclm As Long
    Const defName As String = "DataCol"
    Const defNameOEX_High As String = "OEX_High"
    Const defNameOEX_Low As String = "OEX_Low"
    Const defNameDATE_Range As String = "DATE_Range"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set ws = Worksheets("Vix")
    I = 2 ' ??? What is the first row
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
        Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr() ' This will paste out the Formula values back to the Worksheet

    I = intStartRow ' ???
    Set ws = Worksheets("Put Call Ratio")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":H" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
        Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr()

    I = lr - 22 ' ???
    Do
        dbl9Value = 0: dbl21Value = 0
        For J = I To (I - 20) Step -1
            dbl21Value = ws.Cells(J, 5) + dbl21Value
        Next J
        For J = I To (I - 8) Step -1
            dbl9Value = ws.Cells(J, 5) + dbl9Value
        Next J
        If I > 9 Then ws.Cells(I, 11) = dbl9Value / 9
        If I > 20 Then ws.Cells(I, 12) = dbl21Value / 21
        ws.Cells(I, 11).NumberFormat = "0.00"
        ws.Cells(I, 12).NumberFormat = "0.00"
        I = I + 1
    Loop Until ws.Cells(I, 1) > Now() Or ws.Cells(I, 2) = ""

    I = intStartRow ' ???
    Set ws = Worksheets("OEX")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To UBound(arr(), 1) - 1
        For Cntclm = 1 To UBound(arr(), 2)
            Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr()

    lr = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="='" & ws.Name & "'!$D$2:$D$" & (lr + 1)
    lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="='" & ws.Name & "'!$E$2:$E$" & (lr + 1)
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="='" & ws.Name & "'!$A$2:$A$" & (lr + 1)

    I = 2 ' ??? What is the first row?
    Set ws = Worksheets("Calc")
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("F" & (I - 1) & ":I" & (lr + 1))
    Let arr() = rng.Formula
    For Cntrw = 1 To (UBound(arr(), 1) - 1)
        For Cntclm = 1 To UBound(arr(), 2)
            Let arr(Cntrw + 1, Cntclm) = arr(Cntrw, Cntclm)
        Next Cntclm
    Next Cntrw
    Let rng.Value = arr() ' This will paste out the Formula values back to the Worksheet

    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defName, RefersTo:="='" & ws.Name & "'!$B$2:$B$" & (lr + 1)

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Fair enough perhaps Alan can weigh in as the scheme was his.

[Doc.AElstein]

Hi bknight

....
Fair enough perhaps Alan can weigh in as the scheme was his.

I will do my best :)


_1) As I said a few times, it still seems strange to me to be copying a formula from one row to the next
But never mind…

_2a) My code version shows how much quicker it is to do these sorts of things “In Arrays internally”
It does not do exactly the same as your original code as it is putting exactly the same formula in to every “row”.
I doubt that you want that.
It just demonstrates how faster it is copying from one line to another by taking in the whole data range in one go, doing it all “internally” in an Array, then pasting out all the results in one go.

_2b) If you insist on doing things “row” by “row”, ( and why not it, iis all fun, Lol.... ) then this would be my equivalent code snippet to give excactly the same results as your original code, ( Using the original uploaded File I have from you, ) for Worksheet(“Vix”)
The code builds up the Array with all your required Formulas in it, then pastes them all out in one go over the entire Range
It will still be fairly fast but not as fast as just pasting all formulas in out in one code line ( or rather 4 code lines) like I referenced here: http://www.eileenslounge.com/viewtopic. ... 20#p197151" onclick="window.open(this.href);return false;

Code: Select all

Dim rngVix As Range ' variable to hold the entire Range you are currently considering
 Set rngVix = Worksheets("Vix").Range("F" & I - 1 & ":I" & 3261 & "")
Dim arrrngVix() As Variant ' We know the size of the Array, but must use Re Dim below as Dim only takes Numbers. We must use Variant as otherwise the final Paste Out to the Worksheet for Formula strings does not always work. http://www.mrexcel.com/forum/excel-questions/887822-formula-link-cell-array-instead-cell-value-based-cell-r-c-co-ordinates-2.html
 ReDim arrrngVix(1 To rngVix.Rows.Count, 1 To 4) ' We must use Redim as this allows us to use the Rows Count Property
Dim Cntrw As Long
    For Cntrw = 1 To (UBound(arrrngVix(), 1) - 0) ' at every "row" in the Array, (Up to and including the last),  we ...
    ' ... Put in eanch string Formula
     Let arrrngVix(Cntrw, 1) = "=(F" & intStartRow - 3 + Cntrw & "*$I$3)+(E" & intStartRow - 2 + Cntrw & "*$I$2)" ' like =(F3146*$I$3)+(E3147*$I$2)
     Let arrrngVix(Cntrw, 2) = "=G" & intStartRow - 3 + Cntrw & "*$I$7+E" & intStartRow - 2 + Cntrw & "*$I$6"     ' like =G3146*$I$7+E3147*$I$6
     Let arrrngVix(Cntrw, 3) = "=F" & intStartRow - 2 + Cntrw & "/G" & intStartRow - 2 + Cntrw & ""               ' Like =F3147/G3147
     Let arrrngVix(Cntrw, 4) = "=AVERAGE(E" & intStartRow - 51 + Cntrw & ":E" & intStartRow - 2 + Cntrw & ")"     ' like =AVERAGE(E3098:E3147)
    Next Cntrw
Let rngVix.Value = arrrngVix() ' This will paste out the Formula values to the Worksheet

Alan

EDIT: Code snippet again without the explaining 'Comments

Code: Select all

Dim rngVix As Range
 Set rngVix = Worksheets("Vix").Range("F" & I - 1 & ":I" & 3261 & "")
Dim arrrngVix() As Variant
 ReDim arrrngVix(1 To rngVix.Rows.Count, 1 To 4)
Dim Cntrw As Long
    For Cntrw = 1 To (UBound(arrrngVix(), 1) - 0)
    
     Let arrrngVix(Cntrw, 1) = "=(F" & intStartRow - 3 + Cntrw & "*$I$3)+(E" & intStartRow - 2 + Cntrw & "*$I$2)"
     Let arrrngVix(Cntrw, 2) = "=G" & intStartRow - 3 + Cntrw & "*$I$7+E" & intStartRow - 2 + Cntrw & "*$I$6"
     Let arrrngVix(Cntrw, 3) = "=F" & intStartRow - 2 + Cntrw & "/G" & intStartRow - 2 + Cntrw & ""
     Let arrrngVix(Cntrw, 4) = "=AVERAGE(E" & intStartRow - 51 + Cntrw & ":E" & intStartRow - 2 + Cntrw & ")"
    Next Cntrw
Let rngVix.Value = arrrngVix()

[Doc.AElstein]

BTW.
Using my new code snippet you do not need to keep any formulas in the Worksheet.
So after pasting the formulas out you can add a line like
Let rngVix.Value = rngVix.Value
This would convert the Formulas to the values they give. This may help reduce the size of your File, and might reduce some of the other speed issues

[bknight]

_1) As I said a few times, it still seems strange to me to be copying a formula from one row to the next
But never mind…

Why it should be strange? The formulas are exact duplicates from row to row with just the relative reference changing(cell arithmetic). The results are used in parts for the Calc sheet, you will notice there are no values, just formula links back to cell formulas on various sheets. I really can't explain it any better, perhaps if we were in the same room, we could discuss, but it is what it is. As I said in one of my posts, this macro is just a time saving procedure as I had for many days copied one row to the next on all four pages.

_2a) My code version shows how much quicker it is to do these sorts of things “In Arrays internally”
It does not do exactly the same as your original code as it is putting exactly the same formula in to every “row”.
I doubt that you want that.

If it copies the relative references along with the static ones, that is exactly what it is supposed to be. If the relative or the static references are changed/deleted, that is not what I need.

It just demonstrates how faster it is copying from one line to another by taking in the whole data range in one go, doing it all “internally” in an Array, then pasting out all the results in one go.

_2b) If you insist on doing things “row” by “row”, ( and why not it, iis all fun, Lol.... ) then this would be my equivalent code snippet to do exactly the same as your original code, ( Using the original uploaded File I have from you, ) for Worksheet(“Vix”)

If you suggest another way to arrive at the same results, I'm all ears and will try anything, like the code you supplied.

OK now look at my code, after corrections from Hans. Note this code is stripped of every comment as there is a 7600 character limit to posts as well as your two code examples, if I messed up and deleted extra code, then correct me.

Code: Select all

Sub CopyCellsFormulas()
    Dim dteDateValue As Date
    Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    Dim ws As Worksheet
    Const defName As String = "DataCol"
    Const defNameOEX_High As String = "OEX_High"
    Const defNameOEX_Low As String = "OEX_Low"
    Const defNameDATE_Range As String = "DATE_Range"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set ws = Worksheets("Vix")
    Worksheets("Vix").Activate
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngVix As Range 
    Set rngVix = Worksheets("Vix").Range("F" & lr - 1 & ":I" & lr & "")
    Dim arrrngVix() As Variant 
    Let arrrngVix() = rngVix.Formula 
    Dim Cntrw As Long, Cntclm As Long
        For Cntrw = 1 To (UBound(arrrngVix(), 1) - 1) 
            For Cntclm = 1 To UBound(arrrngVix(), 2) 
            Let arrrngVix(Cntrw + 1, Cntclm) = arrrngVix(Cntrw, Cntclm) 
            Next Cntclm
        Next Cntrw
    Let rngVix.Value = arrrngVix() 
    Cells(lr, 2).Select
    Worksheets("PutCall Ratio").Activate
    Set ws = Worksheets("Put Call Ratio")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngPutCall As Range 
    Set rngPutCall = Worksheets("Put Call Ratio").Range("F" & lr - 1 & ":H" & lr & "")
    Dim arrrngPutCall() As Variant 
    Let arrrngPutCall() = rngPutCall.Formula 
    Dim Cntrw1 As Long, Cntclm1 As Long
        For Cntrw1 = 1 To (UBound(arrrngPutCall(), 1) - 1) 
            For Cntclm1 = 1 To UBound(arrrngPutCall(), 2) 
                Let arrrngPutCall(Cntrw1 + 1, Cntclm1) = arrrngPutCall(Cntrw1, Cntclm1) 
            Next Cntclm1
        Next Cntrw1
    Let rngPutCall.Value = arrrngPutCall() 
    Cells(lr, 2).Select
    I = lr - 22
'Alan these two for statements calculate a 21 and 9 day moving average
    Do
        dbl9Value = 0: dbl21Value = 0
        For J = I To (I - 20) Step -1
            dbl21Value = Cells(J, 5) + dbl21Value
        Next J
        For J = I To (I - 8) Step -1
            dbl9Value = Cells(J, 5) + dbl9Value
        Next J
        If I > 9 Then Cells(I, 11) = dbl9Value / 9
        If I > 20 Then Cells(I, 12) = dbl21Value / 21
        Cells(I, 11).NumberFormat = "0.00": Cells(I, 12).NumberFormat = "0.00"
        I = I + 1
    Loop Until Cells(I, 1) > Now() Or Cells(I, 2) = ""
    Cells(lr, 2).Select
    Worksheets("OEX").Activate
    Set ws = Worksheets("OEX")
    lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rngOex As Range 
    Set rngOex = Worksheets("Oex").Range("H" & lr - 1 & ":H" & lr & "")
    Dim arrrngOex() As Variant 
    Let arrrngOex() = rngOex.Formula 
    Dim Cntrw2 As Long, Cntclm2 As Long
        For Cntrw2 = 1 To (UBound(arrrngOex(), 1) - 1) 
            For Cntclm2 = 1 To UBound(arrrngOex(), 2) 
                Let arrrngOex(Cntrw2 + 1, Cntclm2) = arrrngOex(Cntrw2, Cntclm2) 
            Next Cntclm2
        Next Cntrw2
    Let rngOex.Value = arrrngOex() 
    Cells(lr, 3).Select
    R = Cells(Rows.Count, "D").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="=" & ActiveSheet.Name & "!" & Range("D2", Cells(R + 1, "D")).Address
    R = Cells(Rows.Count, "E").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="=" & ActiveSheet.Name & "!" & Range("E2", Cells(R + 1, "E")).Address
    R = Cells(Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="=" & ActiveSheet.Name & "!" & Range("A2", Cells(R + 1, "A")).Address
    Worksheets("Calc").Activate
    Set ws = Worksheets("Calc")
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim rngCalc As Range ' variable to hold the entire Range you are currently considering
    Set rngCalc = Worksheets("Calc").Range("A" & lr - 1 & ":G" & lr + 1 & "")
    Dim arrrngCalc() As Variant 
    Let arrrngCalc() = rngCalc.Formula 
    Dim Cntrw3 As Long, Cntclm3 As Long
        For Cntrw3 = 1 To (UBound(arrrngCalc(), 1) - 1) 
            For Cntclm3 = 1 To UBound(arrrngCalc(), 2) 
                Let arrrngCalc(Cntrw + 1, Cntclm) = arrrngCalc(Cntrw, Cntclm) 
            Next Cntclm3
        Next Cntrw3
    Let rngCalc.Value = arrrngCalc() 
    Cells(lr, 2).Select
    R = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[bknight]

BTW.
Using my new code snippet you do not need to keep any formulas in the Worksheet.
So after pasting the formulas out you can add a line like
Let rngVix.Value = rngVix.Value
This would convert the Formulas to the values they give. This may help reduce the size of your File, and might reduce some of the other speed issues

Should everything work, I may do just that.

[bknight]

After running the code tonight, Alan, you are correct and incorrect. The code you send does copy the exact formula in each row, but you are incorrect a copy/paste operation does not copy the exact formula but a relative reference at the next row. i.e. "Vix" worksheet row 3261 & 3262
12/12/16 12.23 12.78 12.07 12.64 =(F3260*$I$3)+(E3261*$I$2) =G3260*$I$7+E3261*$I$6 =F3261/G3261 =AVERAGE(E3212:E3261)
12/13/16 12.46 13.42 12.34 12.72 =(F3261*$I$3)+(E3262*$I$2) =G3261*$I$7+E3262*$I$6 =F3262/G3262 =AVERAGE(E3213:E3262)
As I said your code copies the exact code row by row, not relative references.
So we are back to the drawing board. It is fast though.

The completed file as of tonight 2016 Dec 13
https://app.box.com/s/0pc52dzfoi0g0700tlzwjxrvcq3fh3ab" onclick="window.open(this.href);return false;

[Rudi]

Sorry for the confusion...

The 'ws', 'cl' and 'lr' was not actually VBA code -- I just typed that in as a legend to represent a worksheet object as I didn't know how your code was set up.
As Hans mentioned, if you are going to use those as variables they need to be declared (and set).

This would have been the setup (as you have discovered):
BTW: It would be good to declare lr (as long) in the code too.

Code: Select all

Sub Test()
' Macro 12/14/2012 by Terry
' For McClellanOscillator workbook

'cl = Column reference to determine length of (eg: "A")

Dim ws As Worksheet
Dim lr As Long

    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

End Sub

[Doc.AElstein]

Hi bknight
Yes it is very difficult getting info across. I sympathize.
Remember you know your project inside and out.
We are seeing it for the first time, so it is impossible ( for me ) to know from the File and info you gave what is going on. Sorry I am just not that clever :(

I had a file from you initially , where for example in Worksheet Vix , intStartRow = 3148 , and all formulas were included up to 3261. The code you gave, which initially crashed a lot ( making it difficult to see at all what was happening ) , appeared just to be copying and pasting what was already there. So I did not realize what you actually wanted.

The post size limit is unfortunate. ( Sorry that is my fault – I must apologies for that – it was introduced to stop my rambling posts !! ) . But you could edit out some of the text in quoting. – I still have no idea why you are not doing that.

Please remember we are all voluntarily giving our time to help you. I am only learning myself , partly from answering Threads.

I have never said, or meant to say, that “a copy/paste operation copies the exact formula”. Sorry if that message came across. It was not meant to.
I know and agree with you that a “a copy/paste operation copies relative reference at the next row ( or column)” ( Depending on if you include $'s to fix some referrences and make them absolute )

My first code snippet _..
http://www.eileenslounge.com/viewtopic. ... 20#p197140" onclick="window.open(this.href);return false;
_.. is, as you have noticed not doing what you want. I tried to tell you that. Sorry I did not get that message clearly across. At the stage that I wrote it, I still was not sure what you wanted. So I was just demonstrating with that snippet how quick Array codes can be when doing a similar action as that with “spreadsheet interaction techniques”. The code copies the exact formula , row by row, not relative references.
As I later suggested, you do not want that. I did not realize that at the time I initially did it for you. Sorry

As I slowly got a better idea as to what you might want I gave you the second code snippet _..
http://www.eileenslounge.com/viewtopic. ... 40#p197190" onclick="window.open(this.href);return false;
_.. I think this may be doing what you wish, or coming closer. It works slightly differently. - It is not copying any formulas. It creates the full Array with the formulas that you want in them. Then finally pastes them all out.

I have tried to indicate a few times that generally you would use a different method to paste out formulas across a range using R C notation techniques. I have given some references for that. I suggest we possibly try my second code snippet idea first, just as it is a bit easier to understand. Then if we feel up to it we can look at the R C notation techniques. I recommend again if you have time possibly reading up on the references I gave.

_.......

..
As I said your code copies the exact code row by row, not relative references.
….. https://app.box.com/s/0pc52dzfoi0g0700tlzwjxrvcq3fh3ab" onclick="window.open(this.href);return false;

Correct. I agree. Your last full code is using my first code snippet.
You need to use my second code snippet to get the formulas you want. ( I just did the example for Worksheet "Vix" )

I am truly sorry I could not give you an instant solution. I know how frustrating it can be when you need help. I am just not that clever. For a new project I know nothing about, I need much more clearer info than you gave. My failing. Sorry.

I will take a look now at your last uploaded File and see if I can help further.

Ideally, I would like to see two files, if possible with reduced data.
File 1 should show the situation before the macro is run
File 2 should show the situation as you want it, after the macro is run.

I realize that you are having difficulties with the file size and want to address those. But we are seeing already that the Array way is likely to overcome those problems to some extent.
But with reduced file size initially, it would make it easier to get things doing exactly what you want.

Alan

[bknight]

Alan: I know everyone donates time and effort in helping developing help on this and all sites like it.
Now that we have agreement with that, I will ask whether the second code will copy relative references?
viewtopic.php?f=27&t=25344&start=40#p197190 I don't perceive any difference from the first code except that it copies cell by cell across a row, but if that copies relative references, I'll change the code across all of the sheets.
Again as I want to make clear, this code executes all the copying in a single stroke, saving me time and key strokes to complete the table after importing new data.

Ideally, I would like to see two files, if possible with reduced data.
File 1 should show the situation before the macro is run
File 2 should show the situation as you want it, after the macro is run.

I can do that but it won't be reduced data, the link https://app.box.com/s/0pc52dzfoi0g0700tlzwjxrvcq3fh3ab" onclick="window.open(this.href);return false; contains File 2 example
https://app.box.com/s/0pc52dzfoi0g0700tlzwjxrvcq3fh3ab" onclick="window.open(this.href);return false; contains File 1 example, after the days data has been imported into "Vix", "PutCall Ratio" and "OEX" sheets.
Remember the "Calc" sheet contains no data, just links to data sheets formulas very few actual data points.
Thanks for your time and effort.

[Doc.AElstein]

Hi bknight
Thanks for the new files.

.....will ask whether the second code will copy relative references?....

Sort of. – It is not copying anything

....gave you the second code snippet _..
http://www.eileenslounge.com/viewtopic. ... 40#p197190" onclick="window.open(this.href);return false;
_.. I think this may be doing what you wish, or coming closer. It works slightly differently. - It is not copying any formulas. It creates the full Array with the formulas that you want in them. Then finally pastes them all out.....

I think it gives you the formulas that you want. At least that is the idea behind what I was trying to do.
It makes all the formulas in an Array.
Then it pastes them out in one go.

_. I will take a look at the Files for you as soon as I have time. :)

Alan

[Doc.AElstein]

Hi
I think you have given one wrong link -
You have given the same link for both files.
Alan