0

Any ideas why I get this error at the line myrange.Copy ?

THANKS

Sub nsort()
Dim wb As Workbook, ws As Worksheet, myrange As Range

Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
Set range_i = Nothing
counter = 0

'Find last row TrE = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

'Start loop assuming data starts in row 2 and 13 columns wide as in example

For Tr = 2 To TrE

If Not myrange Is Nothing Then
    If ws.Cells(Tr, 13) = 0 Then
        Set myrange = Union(myrange, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
        counter = counter + 1
    End If
Else
    If ws.Cells(Tr, 13) = 0 Then
        Set myrange = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
        counter = counter + 1
    End If
End If

If Not range_i Is Nothing Then
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Union(range_i, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    End If
Else
    If ws.Cells(Tr, 13) > 0 Then
        Set range_i = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
End If
Next Tr

Sheets.Add.Name = "summary"

Set Tws = wb.Sheets("summary")

myrange.Copy

Tws.Range("A1").PasteSpecial

range_i.Copy

Tws.Range(Cells(1 + counter, 1), Cells(1 + counter, 13)).PasteSpecial
End Sub
daneee
  • 153
  • 8
  • 1
    Your loop doesn't actually run because you never assign a value to `TrE` (you commented out the line that does that: `TrE = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row` should be on its own row – Rory Jun 01 '21 at 08:40

1 Answers1

0

Additionally to Rory's comment to activate the following line

TrE = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

so your loop gets executed at all, I recommend to optimize your code block a bit so it is less repetitive:

If Not myrange Is Nothing Then
    If ws.Cells(Tr, 13) = 0 Then
        Set myrange = Union(myrange, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
        counter = counter + 1
    End If
Else
    If ws.Cells(Tr, 13) = 0 Then
        Set myrange = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
        counter = counter + 1
    End If
End If

can be written as

If ws.Cells(Tr, 13) = 0 Then
    If Not myrange Is Nothing Then
        Set myrange = Union(myrange, Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13)))
    Else
        Set myrange = Range(ws.Cells(Tr, 1), ws.Cells(Tr, 13))
    End If
    counter = counter + 1
End If

Same can be done with your second If block.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Thanks so much!! :-) I've incorporated that and I really appreciate you suggesting it. I've also posted a new follow-on question here if you're interested in looking at it some more? https://stackoverflow.com/questions/67803569/excel-macro-format-one-half-of-spreadsheet-red-and-fill-down-until-last-row – daneee Jun 02 '21 at 10:42