Macro not working as expected

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Macro not working as expected

Post by bknight »

Last night I had a very bad experience with the recent upgrade to 2007.

Code: Select all

Sub CopyCellsFormulas()
Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
Dim dteDateValue As Date
Dim dbl9Value As Double, dbl21Value As Double
Dim DataCol As Range
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
'New Data Aquisitions Begins 10/21/2003
'01/02/2004 Row 53
'07/01/2004 Row 177
'01/03/2005 Row 305
'07/01/2005 Row 430
'01/03/2006 Row 557
'07/03/2006 Row 682
'01/02/2009 Row 1312
'01/03/2012 Row 2067
'07/02/2012 Row 2142
'01/02/2013 Row 2267
'07/01/2013 Row 2391
'01/02/2014 Row 2519
'07/01/2016 Row 3148
intStartRow = 3148
I = intStartRow
Worksheets("Vix").Activate
Do
I = I + 1
Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy
Range(Cells(I - 1, 6), Cells(I - 1, 9)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
Cells(I, 2).Select
dteDateValue = Cells(I - 2, 1)
I = intStartRow
Worksheets("PutCall Ratio").Activate
Do
I = I + 1
Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy
Range(Cells(I - 1, 6), Cells(I - 1, 8)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
I = intStartRow
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
Do
I = I + 1
Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy
Range(Cells(I - 1, 8), Cells(I - 1, 8)).PasteSpecial xlPasteAll
Loop Until Cells(I, 3) = ""
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
I = intStartRow - 80
Worksheets("Calc").Activate
Do
I = I + 1
Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
Cells(I, 1).Select
R = Cells(Rows.Count, "B").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address
Application.EnableEvents = True
End Sub
I can't really add the spreadsheet as it is over 3.1Mb. The macro takes four different sheets and copies one row to the next down row until there is blank in the next row.
Anyway several questions remain open from the experience.
1. Is there a setting that forces linked data be opened in the current session of Excel, instead of opening up another session?
2. Notice in the code Application.EnableEvents = False, yet I sit and WATCH every calculation
3. What if any exists a key stroke for breaking/stopping a macro? The calculation took over an hour, Yuk.

EDIT add a piece of the workbook
You do not have the required permissions to view the files attached to this post.

User avatar
Rudi
gamma jay
Posts: 25267
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Macro not working as expected

Post by Rudi »

Without yet scanning through the code or getting to your other questions, this should make more of a difference to the speed.

All you had was disabling events, but using screenupdating and disable automatic calc. mode should speed it up more.

Bear in mind there are a lot of loops and these will take time to run.

I'll look into the others later.... for now, this should help.

Code: Select all

Sub CopyCellsFormulas()
Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
Dim dteDateValue As Date
Dim dbl9Value As Double, dbl21Value As Double
Dim DataCol As Range
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.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    On Error GoTo ErrH
    
    'New Data Aquisitions Begins 10/21/2003
    '01/02/2004 Row 53
    '07/01/2004 Row 177
    '01/03/2005 Row 305
    '07/01/2005 Row 430
    '01/03/2006 Row 557
    '07/03/2006 Row 682
    '01/02/2009 Row 1312
    '01/03/2012 Row 2067
    '07/02/2012 Row 2142
    '01/02/2013 Row 2267
    '07/01/2013 Row 2391
    '01/02/2014 Row 2519
    '07/01/2016 Row 3148
    intStartRow = 3148
    I = intStartRow
    Worksheets("Vix").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy
        Range(Cells(I - 1, 6), Cells(I - 1, 9)).PasteSpecial xlPasteAll
    Loop Until Cells(I, 2) = ""
    Cells(I, 2).Select
    dteDateValue = Cells(I - 2, 1)
    I = intStartRow
    Worksheets("PutCall Ratio").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy
        Range(Cells(I - 1, 6), Cells(I - 1, 8)).PasteSpecial xlPasteAll
    Loop Until Cells(I, 2) = ""
    I = intStartRow
    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
    Do
        I = I + 1
        Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy
        Range(Cells(I - 1, 8), Cells(I - 1, 8)).PasteSpecial xlPasteAll
    Loop Until Cells(I, 3) = ""
    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
    I = intStartRow - 80
    Worksheets("Calc").Activate
    Do
        I = I + 1
        Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
        Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
    Loop Until Cells(I, 2) = ""
    Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
    Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
    Cells(I, 1).Select
    R = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address

ExitH:
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
ErrH:
    MsgBox Err.Description, vbExclamation
    Resume ExitH
End Sub
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

Rudi:
I thought that disabling the events disabled all of the event you listed. Normally, even before last night and including this morning. The macro ran in about 30 sec. Last night there was a constant updating "circle" icon over the workbook as it SLOWLY copied each row.

User avatar
Rudi
gamma jay
Posts: 25267
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Macro not working as expected

Post by Rudi »

Disabling events is just one of the options. This simply prevents any sheet or workbook events from firing if the macro happens to change a value or object that could trigger the event. If your workbook does not contain any event handlers, this line of code is pretty much useless. The better ones to use for most macros (esp. those with loops) is ScreenUpdating and Calculation mode.

See this article for more details....
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
Rudi
gamma jay
Posts: 25267
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Macro not working as expected

Post by Rudi »

Question #3

You can use CTRL+Break (Pause) if you have a standard keyboard.
You could also try pressing Escape a few times (if you have a laptop).
Image 009.jpg
A great tip (again, if you have a laptop -- without a break button) is to activate the on-screen keyboard and use this to CTRL+Break
You do not have the required permissions to view the files attached to this post.
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

Yes I have used the on screen keyboard, but not normally. The break hasn't been an issue until last night.
Thanks for the tip.

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

Did you guys have a look at the macro aside from the changes to automatic changing?

User avatar
HansV
Administrator
Posts: 71141
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro not working as expected

Post by HansV »

I would recommend indenting the code properly, as Rudi did in his first reply. Unindented or sloppily indented code is hard to follow.
I'd avoid selecting cells.
You can use Paste instead of PasteSpecial here.
There are some variables that aren't used.

Code: Select all

Sub CopyCellsFormulas()
    Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    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
    'New Data Aquisitions Begins 10/21/2003
    '01/02/2004 Row 53
    '07/01/2004 Row 177
    '01/03/2005 Row 305
    '07/01/2005 Row 430
    '01/03/2006 Row 557
    '07/03/2006 Row 682
    '01/02/2009 Row 1312
    '01/03/2012 Row 2067
    '07/02/2012 Row 2142
    '01/02/2013 Row 2267
    '07/01/2013 Row 2391
    '01/02/2014 Row 2519
    '07/01/2016 Row 3148

    intStartRow = 3148

    I = intStartRow
    Worksheets("Vix").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 9))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    Worksheets("PutCall Ratio").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 8))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    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) = ""

    I = intStartRow
    Worksheets("OEX").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 8), Cells(I - 1, 8))
    Loop Until Cells(I, 3) = ""

    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
    I = intStartRow - 80
    Worksheets("Calc").Activate
    Do
        I = I + 1
        Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    Loop Until Cells(I, 2) = ""
    Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    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
Regards,
Hans

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

HansV wrote:I would recommend indenting the code properly, as Rudi did in his first reply. Unindented or sloppily indented code is hard to follow.
I'd avoid selecting cells.
Those selections were for final "presentations"
You can use Paste instead of PasteSpecial here.
Will this statement paste?

Code: Select all

Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 9))
There are some variables that aren't used.
I know it was a hangover from the initial coding dteDateValue, was planned as a do loop key, but I never used it or deleted it

Code: Select all

Sub CopyCellsFormulas()
    Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    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
    'New Data Aquisitions Begins 10/21/2003
    '01/02/2004 Row 53
    '07/01/2004 Row 177
    '01/03/2005 Row 305
    '07/01/2005 Row 430
    '01/03/2006 Row 557
    '07/03/2006 Row 682
    '01/02/2009 Row 1312
    '01/03/2012 Row 2067
    '07/02/2012 Row 2142
    '01/02/2013 Row 2267
    '07/01/2013 Row 2391
    '01/02/2014 Row 2519
    '07/01/2016 Row 3148

    intStartRow = 3148

    I = intStartRow
    Worksheets("Vix").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 9))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    Worksheets("PutCall Ratio").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 8))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    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) = ""

    I = intStartRow
    Worksheets("OEX").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 8), Cells(I - 1, 8))
    Loop Until Cells(I, 3) = ""

    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
    I = intStartRow - 80
    Worksheets("Calc").Activate
    Do
        I = I + 1
        Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    Loop Until Cells(I, 2) = ""
    Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    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
I accept the method of development, indents. My bad

User avatar
HansV
Administrator
Posts: 71141
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro not working as expected

Post by HansV »

Range1.Copy Range2

is equivalent to

Range1.Copy Destination:=Range2

This statement copies and pastes in one go.
Regards,
Hans

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

OK, thanks, will make those changes.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1396
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Macro not working as expected

Post by Doc.AElstein »

@ bknight
Hi,
Here is some stuff on the different Copy Paste ways
http://www.eileenslounge.com/viewtopic.php?f=27&t=25002" onclick="window.open(this.href);return false;
Alan
\ -_- / :heavy: :jollyroger:

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

HansV wrote:I would recommend indenting the code properly, as Rudi did in his first reply. Unindented or sloppily indented code is hard to follow.
I'd avoid selecting cells.
You can use Paste instead of PasteSpecial here.
There are some variables that aren't used.

Code: Select all

Sub CopyCellsFormulas()
    Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
    Dim dbl9Value As Double, dbl21Value As Double
    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
    'New Data Aquisitions Begins 10/21/2003
    '01/02/2004 Row 53
    '07/01/2004 Row 177
    '01/03/2005 Row 305
    '07/01/2005 Row 430
    '01/03/2006 Row 557
    '07/03/2006 Row 682
    '01/02/2009 Row 1312
    '01/03/2012 Row 2067
    '07/02/2012 Row 2142
    '01/02/2013 Row 2267
    '07/01/2013 Row 2391
    '01/02/2014 Row 2519
    '07/01/2016 Row 3148

    intStartRow = 3148

    I = intStartRow
    Worksheets("Vix").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 9))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    Worksheets("PutCall Ratio").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 8))
    Loop Until Cells(I, 2) = ""

    I = intStartRow
    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) = ""

    I = intStartRow
    Worksheets("OEX").Activate
    Do
        I = I + 1
        Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy Range(Cells(I - 1, 8), Cells(I - 1, 8))
    Loop Until Cells(I, 3) = ""

    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
    I = intStartRow - 80
    Worksheets("Calc").Activate
    Do
        I = I + 1
        Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    Loop Until Cells(I, 2) = ""
    Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy Range(Cells(I, 1), Cells(I, 7))
    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
Hans:
I have a serious problem. As with this mornings post the code you provided is taking forever, Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy Range(Cells(I - 1, 6), Cells(I - 1, 9)) is taking perhaps 5 minutes to complete? Last week it was slow but the disabling of screen updates helped out, tonight it is really slow.

I did an update to service pack 3 this weekend, something that I forgot this morning. Could there be a corruption in the application, because this is way different than last week.

Is there anything else that might be done?

User avatar
Rudi
gamma jay
Posts: 25267
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Macro not working as expected

Post by Rudi »

Besides really high volumes of data to process, nothing in the code suggests that it should run very slow. Its going to be hard to pinpoint the problem without testing it on the file you are working with. Would it be possible to upload a desensitized copy of your file. It would help to determine how your code is running on the actual data structure of your file and where the delays are occurring.
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1396
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Macro not working as expected

Post by Doc.AElstein »

bknight wrote:...
I can't really add the spreadsheet as it is over 3.1Mb. ....
Hi bknight,
For uploading a large File you could use one of the File sharing sites, such as this free one:
https://app.box.com/signup/n/personal" onclick="window.open(this.href);return false;
Remember to mark the File as Share and give us the Link to the File that they provide:
ShareFilebox.jpg http://imgur.com/hE3v2mA" onclick="window.open(this.href);return false;
ShareFilebox.JPG
Alan
You do not have the required permissions to view the files attached to this post.
\ -_- / :heavy: :jollyroger:

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

Doc.AElstein wrote:
bknight wrote:...
I can't really add the spreadsheet as it is over 3.1Mb. ....
Hi bknight,
For uploading a large File you could use one of the File sharing sites, such as this free one:
https://app.box.com/signup/n/personal" onclick="window.open(this.href);return false;
Remember to mark the File as Share and give us the Link to the File that they provide:
ShareFilebox.jpg http://imgur.com/hE3v2mA" onclick="window.open(this.href);return false;
ShareFilebox.JPG
Alan
I'm not impressed with this site, registered and still waiting the confirmation email.

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

GRRRRR Box is slow.

https://app.box.com/s/3gq9601yj7bb9mpflvqsy942xmqapg6c" onclick="window.open(this.href);return false;
Linking address.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1396
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Macro not working as expected

Post by Doc.AElstein »

bknight wrote:GRRRRR Box is slow....
Hi bknight,
I just tried with a spare Email Address. The confirmation Email came about 5 seconds after I registered. . The site itself is used by many and is usually very quick and reliable and rarely bugs you with offers or Advertisements etc.

I use box a lot on very old computers, which are generally somewhat slower than most peoples. However box uploading always works very quickly for me.

( I wonder if your speed problems generally may possibly therefore lie somewhere else… ?? )

Another alternative that is very popular is Dropbox
https://www.dropbox.com/" onclick="window.open(this.href);return false;
That seems to be extremely popular. I stopped using it as it seemed to bug me a bit more often than box with offers and advertisements
Alan
\ -_- / :heavy: :jollyroger:

bknight
5StarLounger
Posts: 651
Joined: 08 Jul 2016, 18:53

Re: Macro not working as expected

Post by bknight »

Doc.AElstein wrote:
bknight wrote:GRRRRR Box is slow....
Hi bknight,
I just tried with a spare Email Address. The confirmation Email came about 5 seconds after I registered. . The site itself is used by many and is usually very quick and reliable and rarely bugs you with offers or Advertisements etc.
After waiting maybe 10 minutes, I hit the resend confirmation and arrived in the time frame you observed

I use box a lot on very old computers, which are generally somewhat slower than most peoples. However box uploading always works very quickly for me.

( I wonder if your speed problems generally may possibly therefore lie somewhere else… ?? )
Doubtful, but at least possible

Another alternative that is very popular is Dropbox
https://www.dropbox.com/" onclick="window.open(this.href);return false;
That seems to be extremely popular. I stopped using it as it seemed to bug me a bit more often than box with offers and advertisements
Alan
I don't need any more bugging as my spam folder grows by about 50 per day

User avatar
HansV
Administrator
Posts: 71141
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Macro not working as expected

Post by HansV »

I downloaded the workbook but opening it fails. After Excel had been using 100% CPU capacity for over 20 minutes, I killed it...
Regards,
Hans