Problem with Sort in VBA

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
Code:
Sub Recap()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim a As Long
Dim b As Long
Dim i As Long
Dim LstRw As Long, Col As Integer
Set ws1 = Sheets("PAYCALC")
Set ws2 = Sheets("CREW RECAP")

With ws2.UsedRange
    .RemoveSubtotal
    .Cells.Clear
End With
Application.ScreenUpdating = False
a = Sheets("PAYCALC").UsedRange.Rows.Count
b = 1
For i = 5 To a Step 21
Sheets("PAYCALC").Range("B" & i & ":B" & i + 9).Copy
Sheets("Crew Recap").Range("A" & b).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
b = b + 1
Next i
With Sheets("Crew Recap")
    .Columns("F:F").Insert Shift:=xlRight
    i = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
 With .Range("F1:F" & i)
    .FormulaR1C1 = "=RC[-2]&RC[-1]"
     .Copy
     .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   ws2.Columns("D:E").Delete Shift:=xlToLeft
   ws2.Columns("F:H").Delete Shift:=xlToLeft
   ws2.Rows("1").Insert Shift:=xlDown
End With
End With

With ws2
x = 10
lastrow = ws1.Range("C65536").End(xlUp).Row
Do

newRow = ws2.Cells(65536, 7).End(xlUp).Offset(1, 0).Row
ws2.Cells(newRow, 7) = ws1.Cells(x, 9).Offset(-5, 0).Value
ws2.Cells(newRow, 8) = ws1.Cells(x, 15).Offset(-5, 0).Value
ws2.Cells(newRow, 9) = ws1.Cells(x, 9).Offset(-4, 0).Value
ws2.Cells(newRow, 10) = ws1.Cells(x, 15).Offset(-4, 0).Value
ws2.Cells(newRow, 11) = ws1.Cells(x, 9).Offset(-3, 0).Value
ws2.Cells(newRow, 12) = ws1.Cells(x, 15).Offset(-3, 0).Value
ws2.Cells(newRow, 11) = ws1.Cells(x, 9).Offset(-2, 0).Value
ws2.Cells(newRow, 13) = ws1.Cells(x, 15).Offset(-2, 0).Value
ws2.Cells(newRow, 14) = ws1.Cells(x, 9).Offset(-1, 0).Value
ws2.Cells(newRow, 15) = ws1.Cells(x, 15).Offset(-1, 0).Value
ws2.Cells(newRow, 16) = ws1.Cells(x, 9).Offset.Value
ws2.Cells(newRow, 17) = ws1.Cells(x, 15).Offset.Value
ws2.Cells(newRow, 18) = ws1.Cells(x, 9).Offset(1, 0).Value
ws2.Cells(newRow, 19) = ws1.Cells(x, 15).Offset(1, 0).Value


x = x + 21
Loop Until x >= lastrow
   .Cells(1, 1) = "JOB NO"
        .Cells(1, 2) = "LOT"
        .Cells(1, 3) = "MODEL"
        .Cells(1, 4) = " CODE"
        .Cells(1, 5) = "TOTAL PAY"
        .Cells(1, 5).WrapText = True
        .Cells(1, 6) = "CREW"
        .Cells(1, 7) = "FORMAN"
        .Cells(1, 8) = "PAY"
        .Cells(1, 9) = Format(ws1.Range("C4"), "dd mmm yy")
        .Cells(1, 10) = "PAY"
        .Cells(1, 11) = "MEMBER"
        .Cells(1, 12) = "PAY"
        .Cells(1, 13) = "MEMBER"
        .Cells(1, 14) = "PAY"
        .Cells(1, 15) = "MEMBER"
        .Cells(1, 16) = "PAY"
        .Cells(1, 17) = "MEMBER"
        .Cells(1, 18) = "PAY"
        .Cells(1, 19) = "MEMBER"
        .Cells(1, 20) = "PAY"
        .Cells(1, 21) = "MEMBER"
        .Cells(1, 22) = "PAY"
        .Cells(1, 23) = "MEMBER"
        .Cells(1, 24) = "PAY"
       End With
        With ws2.Columns("A:X")
        .Name = "Arial"
        .Font.Size = 8
        .Rows(1).Font.Bold = True
        Range("E:E,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X"). _
    NumberFormat = "0.00"
        .Columns("A:X").AutoFit
        .AutoFilter
        .Columns("B:E").HorizontalAlignment = xlCenter
        
End With
       With ws2.UsedRange
        .BorderAround Weight:=xlHairline
        .Borders(xlInsideVertical).Weight = xlHairline
        .Borders(xlInsideHorizontal).Weight = xlHairline
        End With
    With Sheets("Crew Recap")
 LstRw = Range("F2").End(xlDown).Row

For Col = 8 To 24 Step 2
  With Range(Cells(2, Col), Cells(LstRw, Col)).Borders(xlEdgeRight)
    .LineStyle = xlContinuous:
    .Weight = xlMedium:
    .ColorIndex = xlAutomatic
 End With
Next
End With
    With ws2.Range("E:E")
        .Font.Bold = True
        .Range("A1:X2500").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
            xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
             DataOption1:=xlSortNormal
        
        .Range("A5").Select
         Selection.SubTotal GroupBy:=6, Function:=xlSum, TotalList:=Array(5, 8, 10, 12, _
        14, 16, 18, 20, 22, 24), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
Application.ActiveWindow.DisplayZeros = False
Application.ScreenUpdating = False

End Sub

When I step through the code everything works fine, sometimes and other times not.

When I Run it I get this error 1004
"The sort reference is not valid. Make sure that it's within the data you want to sort, and the first Sort By box isn't the same or blank."

F2 is not blank nor is any cell in that column.

I tried changeing F2 to F1 and even recorded it on the macro recorder. The recorder gave me virtually the same thing I have. Cant' figure this one out.

Harry
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Joined
Jul 30, 2006
Messages
3,656
Harry,

It is a little difficult to follow your code because of indents.

I think that the 'With range'
With ws2.Range("E:E")
is not correct for the 'Sort range'
.Range("A1:X2500")


Code:
    With ws2.Range("E:E") 
        .Font.Bold = True 
        .Range("A1:X2500").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _ 
            xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
             DataOption1:=xlSortNormal 
        
        .Range("A5").Select 
         Selection.SubTotal GroupBy:=6, Function:=xlSum, TotalList:=Array(5, 8, 10, 12, _ 
        14, 16, 18, 20, 22, 24), Replace:=True, PageBreaks:=False, SummaryBelowData:=True 
End With

Have a great day,
Stan
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Code:
    With ws2
        .Range("E:E").Font.Bold = True
        .Range("A1:X2500").Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:= _
            xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
             DataOption1:=xlSortNormal
 

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
I corrected that part of the code as suggested by jindon. I still get the same error.

The strange part is, the error occurs when I have ws1 as the active sheet (this is where the button to run it is)

With the line
Code:
.Range("A1:X2500").Sort Key1:=.Range("F2"), Order1:=xlAscending.....etc.....
highlighted, if I activate ws2 and hit the F8 key it will go through the rest of the code.

Is it possible that I have to activate ws2 somewhere in the code? Which I thought that Activate and Select weren't necessary.

Harry
 

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613

ADVERTISEMENT

Okay, I found my problem.

I didn't have the period before Range("F2")

Thanks
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
OK let's clean up the code first.
Check the lines with "?", you are putting different value to the same cell.
You should delete one of them.
Code:
Sub RecapCleaned()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim a As Long
Dim b As Long
Dim i As Long
Dim LstRw As Long, Col As Integer
Set ws1 = Sheets("PAYCALC")
Set ws2 = Sheets("CREW RECAP")

With ws2.UsedRange
    .RemoveSubtotal
    .Cells.Clear
End With
Application.ScreenUpdating = False
a = ws1.UsedRange.Rows.Count
b = 1
For i = 5 To a Step 21
     ws1.Range("B" & i & ":B" & i + 9).Copy
     ws2.Range("A" & b).PasteSpecial Paste:=xlValues, Transpose:=True
b = b + 1
Next i
With ws2
     .Columns("F:F").Insert Shift:=xlRight
     i = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
     With .Range("F1:F" & i)
         .FormulaR1C1 = "=RC[-2]&RC[-1]"
         .Value = .Value
     End With
     .Columns("D:E").Delete Shift:=xlToLeft
     .Columns("F:H").Delete Shift:=xlToLeft
     .Rows("1").Insert Shift:=xlDown
     x = 10
     lastrow = ws1.Range("C65536").End(xlUp).Row
     Do
          newRow = ws2.Cells(65536, 7).End(xlUp).Offset(1, 0).Row
         .Cells(newRow, 7) = ws1.Cells(x, 9).Offset(-5, 0).Value
         .Cells(newRow, 8) = ws1.Cells(x, 15).Offset(-5, 0).Value
         .Cells(newRow, 9) = ws1.Cells(x, 9).Offset(-4, 0).Value
         .Cells(newRow, 10) = ws1.Cells(x, 15).Offset(-4, 0).Value
         .Cells(newRow, 11) = ws1.Cells(x, 9).Offset(-3, 0).Value  '<- ?
         .Cells(newRow, 12) = ws1.Cells(x, 15).Offset(-3, 0).Value
         .Cells(newRow, 11) = ws1.Cells(x, 9).Offset(-2, 0).Value  '<- ?
         .Cells(newRow, 13) = ws1.Cells(x, 15).Offset(-2, 0).Value
         .Cells(newRow, 14) = ws1.Cells(x, 9).Offset(-1, 0).Value
         .Cells(newRow, 15) = ws1.Cells(x, 15).Offset(-1, 0).Value
         .Cells(newRow, 16) = ws1.Cells(x, 9).Offset.Value
         .Cells(newRow, 17) = ws1.Cells(x, 15).Offset.Value
         .Cells(newRow, 18) = ws1.Cells(x, 9).Offset(1, 0).Value
         .Cells(newRow, 19) = ws1.Cells(x, 15).Offset(1, 0).Value
        x = x + 21
     Loop Until x >= lastrow
        .Cells(1, 1) = "JOB NO"
        .Cells(1, 2) = "LOT"
        .Cells(1, 3) = "MODEL"
        .Cells(1, 4) = " CODE"
        .Cells(1, 5) = "TOTAL PAY"
        .Cells(1, 5).WrapText = True
        .Cells(1, 6) = "CREW"
        .Cells(1, 7) = "FORMAN"
        .Cells(1, 8) = "PAY"
        .Cells(1, 9) = Format(ws1.Range("C4"), "dd mmm yy")
        .Cells(1, 10) = "PAY"
        .Cells(1, 11) = "MEMBER"
        .Cells(1, 12) = "PAY"
        .Cells(1, 13) = "MEMBER"
        .Cells(1, 14) = "PAY"
        .Cells(1, 15) = "MEMBER"
        .Cells(1, 16) = "PAY"
        .Cells(1, 17) = "MEMBER"
        .Cells(1, 18) = "PAY"
        .Cells(1, 19) = "MEMBER"
        .Cells(1, 20) = "PAY"
        .Cells(1, 21) = "MEMBER"
        .Cells(1, 22) = "PAY"
        .Cells(1, 23) = "MEMBER"
        .Cells(1, 24) = "PAY"
        With .Columns("A:X")
             .Name = "Arial"
             .Font.Size = 8
             .Rows(1).Font.Bold = True
        End With
        .Range("E:E,H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X"). _
    NumberFormat = "0.00"
        .Columns("A:X").AutoFit
        .AutoFilter
        .Columns("B:E").HorizontalAlignment = xlCenter
        .UsedRange.Border.Weight:=xlHairline
        LstRw = .Range("F2").End(xlDown).Row

       For Col = 8 To 24 Step 2
            With .Range(.Cells(2, Col), .Cells(LstRw, Col)).Borders(xlEdgeRight)
                .LineStyle = xlContinuous:
                .Weight = xlMedium:
                .ColorIndex = xlAutomatic
            End With
       Next
      .Range("E:E").Font.Bold = True
      .Range("A1:X2500").Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
            xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
             DataOption1:=xlSortNormal
        
        .Range("A5").SubTotal GroupBy:=6, Function:=xlSum, TotalList:=Array(5, 8, 10, 12, _
        14, 16, 18, 20, 22, 24), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
Application.ActiveWindow.DisplayZeros = False
Application.ScreenUpdating = False

End Sub
 

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613

ADVERTISEMENT

Thanks for the help on the Clean up and that was a good catch on the cells that were getting overwritten.

One other question.

Is there a different way of not displaying Zeros on this sheet or just this workbook other than
Code:
Application.ActiveWindow.DisplayZeros = False

Would I have to declare which columns I wanted it not to show zeros?

Harry
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
I think it was ActiveWindow property so, it should be set sheet by sheet with activesheet.

What I mean is you need to activate the sheet in question to set that property and you can not set it by columns/rows.
 

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
Thanks for your help again jindon

Have a great day

Harry
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,891
Messages
5,766,966
Members
425,391
Latest member
Alono23

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