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