Can't get last piece of code to run uless I run the SUB twice.

[S.H.A.D.O.]

Good evening,

The following code works great but ONLY if I run it twice...

Sub Colate()
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    With Sheets("Working Sheet")
        Range("D3:D503").Select
        Selection.Copy
        Range("F3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range( _
            "F3:F503"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With Sheets("Working Sheet").Sort
            .SetRange Range("F3:F503")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        With Sheets("Working Sheet")
            Range("H3:H3").Select
            Selection.Copy
            Range("H6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        End With
    End With
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

...the piece of code that requires to be run twice is this piece...

        With Sheets("Working Sheet")
            Range("H3:H3").Select
            Selection.Copy
            Range("H6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        End With

...but I don't understand why?

Thanks in advance.

 

[S.H.A.D.O.]

Hi Mark, I have got it working using the code below...

Sub Colate_Millionaire_Raffle_Numbers()
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    With Sheets("Working Sheet")
        .Range("D3:D503").Copy
        .Range("F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("F3:F503"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
    End With
    With Sheets("Working Sheet").Sort
        .SetRange Range("F3:F503")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
    With Sheets("Working Sheet")
        .Range("H3").Copy
        .Range("H6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        .Range("H8").Select
        Application.CutCopyMode = False
    End With
End Sub

Thanks again for your time.

 

[Michael M]

Mark
Your code works fine for me...
However, I'm not a fan of

 With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With

on the one line....I read sometime ago that this may cause problems. Maybe I've been infected by that article, but I prefer the "old" method"

Sub Colate()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    With Sheets("Working Sheet")
        .Range("D3:D503").Copy
        Range("F3").PasteSpecial Paste:=xlPasteValues
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range( _
                                  "F3:F503"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                             xlSortNormal
    End With

    With Sheets("Working Sheet").Sort
        .SetRange Range("F3:F503")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    With Sheets("Working Sheet")
        .Range("H3").Copy
        .Range("H6").PasteSpecial Paste:=xlPasteValues
    End With

    With Application
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

 

[MARK858]

Thanks Michael, I'm not a great fan either (it was left from the original code S.H.A.D.O. posted) although I hadn't previously heard of any issue with that way of coding (which is why I didn't remove / alter it).

My previous issue with that way of coding is I just find it harder to read and so I also prefer the "old" method (especially now as you have heard of there being an issue with the syntax).

Thanks for the info as it gives me good reason to change it in future posts

It'll be interesting to see if S.H.A.D.O tests it and reports back if it made any difference in his / her case.

 

[S.H.A.D.O.]

Thank you both for your time and input.
I got up this morning and realised why I was having a problem. It was because there is a Concatenate formula in cell H3, and the screen needed to be updated first for the COPY to work, as simple as that.

Therefore moving the code...

    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With

...up above the COPY corrected the problem.

Thank you both again.

 

[Michael M]

Another issue with using that layout is.....debugging....you can't insert a Breakpoint

With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With