Deleting a number of separate rows at the same time

There seems to be a limitation in the number of separate lines that can be deleted which is causing this routine a problem. Can anyone think of another approach I can try?

    TStrArr = ""
    SCnt = 0
    XCnt = 0
    PageArr = WsName1.Range(DELs & FirstRowSig & ":" & DELs & LastRowNew)
    'Note PageArr will be in the form (row, column)
    For Aloop = LBound(PageArr, 1) To UBound(PageArr, 1)
        If UCase(PageArr(Aloop, 1)) = "Y" Then
            TStrArr = TStrArr & "," & SIGNAME & Aloop + FirstRowSig - 1 & ":" & LASTCOL & Aloop + FirstRowSig - 1
            If Aloop >= FirstRowSig And Aloop <= LastRowSig Then SCnt = SCnt + 1
            If Aloop >= FirstRowNew And Aloop <= LastRowNew Then XCnt = XCnt + 1
        End If
    Next Aloop
    If Len(TStrArr) > 0 Then
        If Left(TStrArr, 1) = "," Then
            TStrArr = Right(TStrArr, Len(TStrArr) - 1)
        End If
        Range(TStrArr).Delete Shift:=xlUp '### It will error here if there are to many rows
        LastRowSig = LastRowSig - SCnt
        LastRowNew = LastRowNew - (SCnt + XCnt)
        LastRowNo1 = WsName1.Range("B65536").End(xlUp).Row
        If LastRowNo1 < FirstRowSig Then
        'check if any data at all
            LastRowNo1 = FirstRowSig
            LastRowSig = LastRowNo1
            FirstRowNew = LastRowSig + 1
            LastRowNew = FirstRowNew
        Else
            If LastRowSig < FirstRowSig Then LastRowSig = FirstRowSig
            If LastRowNew < FirstRowNew Then LastRowNew = FirstRowNew
        End If
    End If

I must honestly admit that I am having trouble understanding your code but I played around a bit with ranges and the union instruction and was able to build a range of 500 individual rows and delete them without a problem using the code below. Perhaps that is something to explore?

Public Sub TestRowDelete()
'#declare
     Dim xlsRange As Excel.Range
     Dim lngRowNumber As Long
'# for the current worksheet
     With Worksheets("Sheet1")
     '# initial range
          Set xlsRange = .Rows(1)
     '# add individual rows
          For lngRowNumber = 2 To 1000 Step 2
               Set xlsRange = Union(xlsRange, Rows(lngRowNumber))
               .Cells(lngRowNumber, "A").Value = "to_delete"
          Next lngRowNumber
     '# delete
          xlsRange.Delete
     End With
End Sub

PS writing the value "to_delete" to cell A is just for testing purposes and not needed

Cheers for that, with a bit of fiddling I changed

TStrArr = TStrArr & "," & SIGNAME & Aloop + FirstRowSig - 1 & ":" & LASTCOL & Aloop + FirstRowSig - 1

and

        If Left(TStrArr, 1) = "," Then
            TStrArr = Right(TStrArr, Len(TStrArr) - 1)
        End If
        Range(TStrArr).Delete Shift:=xlUp '### It will error here if there are to many rows

for

            If SetOK = False Then
                Set xlsRange = WsName1.Range(SIGNAME & Aloop + FirstRowSig - 1 & ":" & LASTCOL & Aloop + FirstRowSig - 1)
                SetOK = True
            Else
                Set xlsRange = Union(xlsRange, WsName1.Range(SIGNAME & Aloop + FirstRowSig - 1 & ":" & LASTCOL & Aloop + FirstRowSig - 1))
            End If

and

    If SetOK Then xlsRange.Delete Shift:=xlUp

and it works ?

It does indeed. I had to set it up that way as I would never know which was the first range to set for deletion. it did throw up later an out of memory message though, I'm not sure if it is related.