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
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
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
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
The Create button will be enabled when you enter a new name in the 'Macro name' box:bknight wrote:Selecting the View option
1. Run
2. Step into
3. Edit
4. Create -->BUT it is greyed out
5. Delete
6. Options
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
I am sorry but the way you are using Quotes in the Post is totally confusing me.bknight wrote:.......Do you set the range containing blank rows(where formulas will go)?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?
I may not be needed now.HansV wrote: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.
lr should replace IntStartRow2) You use the variable intStartRow before having assigned a value to it, so it will be 0.
I will fix them, good eye3) You refer to Worksheets("Put Call Ratio") and to Worksheets("PutCall Ratio"). Only one of these is correct.
Some may have been variables, but I will check4) You create formulas that refer to sheets with spaces in their name without enclosing the sheet name in apostrophes.
Fair enough perhaps Alan can weigh in as the scheme was his.
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
bknight wrote:....
Fair enough perhaps Alan can weigh in as the scheme was his.
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
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()
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.Doc.AElstein wrote: _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…
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.
_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 you suggest another way to arrive at the same results, I'm all ears and will try anything, like the code you supplied.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”)
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
Should everything work, I may do just that.Doc.AElstein wrote: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
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
Correct. I agree. Your last full code is using my first code snippet.bknight wrote:..
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;
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 exampleIdeally, 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.
bknight wrote:.....will ask whether the second code will copy relative references?....
I think it gives you the formulas that you want. At least that is the idea behind what I was trying to do.Doc.AElstein wrote:....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.....