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