"With ws2" code not doing what it's supposed to

pbt

Well-known Member
Joined
Oct 18, 2005
Messages
1,613
This is what I have:

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")
On Error Resume Next
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
        '.Font.Bold = True
        Range("F:F,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
        .Rows(1).Font.Bold = True
End With
       With ws2.UsedRange
        .BorderAround Weight:=xlHairline
        .Borders(xlInsideVertical).Weight = xlHairline
        .Borders(xlInsideHorizontal).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
End With
    With ws2.Range("E:E")
     Range(ActiveCell, ActiveCell.End(xlDown)).Offset(0, -1) _
    .BorderAround Weight:=xlThick
    .Font.Bold = True
End With
With ws2 '''''From here down it applies the sort to ws1
     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.ScreenUpdating = False
End Sub

Everything works fine up to the point that is commented.

This code is assigned to a button and activated from a button on ws1.

The sort is done on ws1, but should be done on ws2.
The Subtotal doesn't even get done on either sheet.

I can't figure this out. HELP what did I do wrong!

Harry

P.S. If you see something that I can do to shorten this code, that would be great.
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Re: "With ws2" code not doing what it's supposed t

Hi
Missing "." period to refer the object referred by With statment
Code:
With ws2 '''''From here down it applies the sort to ws1
     .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.ScreenUpdating = False
End Sub
 

Forum statistics

Threads
1,181,367
Messages
5,929,552
Members
436,677
Latest member
CathalP1992

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