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

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Good evening,

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

Code:
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...

Code:
        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.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Possibly try...

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

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Hi Mark,

Thanks for the reply, unfortunately that doesn't work either.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Does the below run better?

Edited code.

Code:
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, 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 Sheets("Working Sheet")
        .Range("H3").Copy
        .Range("H6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                           :=False, Transpose:=False
    End With

    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub
 
Last edited:

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915

ADVERTISEMENT

Hi Mark,

Thanks for the reply, unfortunately that doesn't work either, it still needs to be run twice.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Are you sure about this?

Copy the data below into a new workbook in a blank sheet called Working Sheet, Run the code below once and post back what is in cell H6.

Excel Workbook
ABCDEFGHIJKL
1333840383240303440363136
2323031353134403131363140
333323937313439zzz30303932
4393538393531343931373632
5393930343831333434333639
6334036353633334040363838
7343834313237353239353239
8313437393230403937373039
9383438383339304033303638
10303933333731303640403536
11313530393834393232363733
12404038394031343435313732
13304030323233373835403534
14303035344036303834383037
Working Sheet




Code:
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, 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 Sheets("Working Sheet")
        .Range("H3").Copy
        .Range("H6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                           :=False, Transpose:=False
    End With

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

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915

ADVERTISEMENT

Thanks again for the reply Mark.
I get zzz in cell H6.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Then the code has run through to completion because the last copy code copies the zzz which was in H3 to H6.
 

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Well I have adjusted my code and still can't get it to do the last copy, I just don't understand it. Here is the revised code.

Code:
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, 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 Sheets("Working Sheet")
           .Range("H3").Copy
           .Range("H6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=False
    End With
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Thanks again.
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,140
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Perhaps you will get a better idea of what is happening if you comment out

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

and then step through the code with F8.
 

Forum statistics

Threads
1,136,445
Messages
5,675,899
Members
419,591
Latest member
mersanko

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
Top