Macro to find blank cells, and then cut the entire row to paste elsewhere

[TheRedCardinal]

Hi all,

My basic requirement is this:

I have a table of data that has been through some processing already. In it, there will be rows where a certain column, labelled "Invoice" will be blank.

In those cases, I want to cut the whole row, and then paste it underneath the table in a new row.

I have made the following code:

[SIZE=2][FONT=arial]'A Sub to deal with intrastat lines with no invoices[/FONT][/SIZE]
[SIZE=2][FONT=arial]'Assumption = will be removed[/FONT][/SIZE]
[SIZE=2][FONT=arial]
[/FONT][/SIZE]
[SIZE=2][FONT=arial]Dim TableRows As Long, PasteRow As Long, Counter As Long, InvoiceColumn As Range[/FONT][/SIZE]
[SIZE=2][FONT=arial]
[/FONT][/SIZE][SIZE=2][FONT=arial]Set ws1 = Sheets("2. Final Data")[/FONT][/SIZE]
[SIZE=2][FONT=arial]ws1.Activate[/FONT][/SIZE]
[SIZE=2][FONT=arial]
[/FONT][/SIZE]
[SIZE=2][FONT=arial]    With ws1[/FONT][/SIZE]
[SIZE=2][FONT=arial]        TableRows = .Cells(Rows.Count, 1).End(xlUp).Row[/FONT][/SIZE]
[SIZE=2][FONT=arial]        Set InvoiceColumn = .Range("A1:Z1").Find("Invoice")[/FONT][/SIZE]

[SIZE=2][FONT=arial]    End With[/FONT][/SIZE]

[SIZE=2][FONT=arial]Cells(TableRows + 2, 1) = "Lines Removed From Intrastat"[/FONT][/SIZE]
[SIZE=2][FONT=arial]PasteRow = TableRows + 3[/FONT][/SIZE]
[SIZE=2][FONT=arial]
[/FONT][/SIZE]
[SIZE=2][FONT=arial]    For Counter = TableRows To 2 Step -1[/FONT][/SIZE]


[SIZE=2][FONT=arial]        If Range(Counter, InvoiceColumn).Value = "" Then[/FONT][/SIZE]
[SIZE=2][FONT=arial]            Rows(Counter).EntireRow.Cut[/FONT][/SIZE]
[SIZE=2][FONT=arial]            Rows(PasteRow).Insert Shift:=xlDown[/FONT][/SIZE]
[SIZE=2][FONT=arial]            PasteRow = PasteRow + 1[/FONT][/SIZE]
[SIZE=2][FONT=arial]        End If[/FONT][/SIZE]

[SIZE=2][FONT=arial]    Next Counter[/FONT][/SIZE]
[SIZE=2][FONT=arial]
[/FONT][/SIZE]
[SIZE=2][FONT=arial]End Sub[/FONT][/SIZE]

The purpose of this code should be obvious. It starts at the bottom of the table and works up. It looks in Cell (Counter, InvoiceColumn) to see if it's blank.
If it is, it cuts the whole row, and pastes it into PasteRow.
It then increases Paste Row by 1 so the next row goes in the right place.
Loop up until 2.

I think the problem is in the characterisation of the Column Tab, which when I debug is called "Invoice" rather than what I would expect, which is 3 (Invoice in this example is found in column c).

So I think this line:

Set InvoiceColumn = .Range("A1:Z1").Find("Invoice")

Is not not doing the thing I thought it would, which is to return the column reference to the cell which matches "Invoice".

The error by the way is "Runtime Error 1004 - Method Range of Object Global Failed.

 

[TheRedCardinal]

Ok I have made some progress on this, by creating a new Variable "InvoiceNumber" and defining it as follows:

InvoiceNumber = InvoiceColumn.Column

This has returned me a 3, that I have then used in a modified sequence as follows:

For Counter = TableRows To 2 Step -1        
        
        If ws1.Cells(Counter, InvoiceNumber).Value = "" Then
            ws1.Rows(Counter).EntireRow.Cut
            ws1.Rows(PasteRow).Insert Shift:=xlDown
            PasteRow = PasteRow + 1
        End If
    
    Next Counter

Now I get a new error - "you can't rearrange cells within a table this way because it might affect other table cells in an unexpected way."

This happens at this line, i.e. the paste row section.

ws1.Rows(PasteRow).Insert Shift:=xlDown

This surprises me because at this point, PasteRow = 311, and TableRows (which counted the number of original lines I had) is 311, so this is away from the table.

Any suggestions how to fix this? The status of the table is not relevant, but it is copied from an ERP system which downloads data as a table and so this is how it comes into my workbook.

 

[TheRedCardinal]

I will solve this myself then shall I

I have now made a loop to remove the Table status of the data, and now it works "perfectly" for me.

My new code looks like this:

Sub MoveNoInvoicesNumber()

'A Sub to deal with intrastat lines with no invoices
'Assumption = will be removed


Dim TableRows As Long, PasteRow As Long, Counter As Long, InvoiceColumn As Range, InvoiceNumber As Long
Dim Table As ListObject






Set ws1 = Sheets("2. Final Data")
ws1.Activate


    With ws1
        TableRows = .Cells(Rows.Count, 1).End(xlUp).Row
        Set InvoiceColumn = .Range("A1:Z1").Find("Invoice")
        InvoiceNumber = InvoiceColumn.Column
    End With


'Remove Table setting for the Data


    For Each Table In ws1.ListObjects
        Table.Unlist
    Next Table
    


    
    Cells(TableRows + 2, 1) = "Lines Removed From Intrastat - No Invoice Number"
    Cells(TableRows + 2, 1).Font.Bold = True
    
    PasteRow = TableRows + 4


        For Counter = TableRows To 2 Step -1
        
        
            If ws1.Cells(Counter, InvoiceNumber).Value = "" Then
                ws1.Rows(Counter).EntireRow.Cut
                ws1.Rows(PasteRow).Insert
                'PasteRow = PasteRow + 1                
            End If
    
        Next Counter


End Sub

Two things I'd like to ask:

Firstly, this bit of code I thought would be needed:

'PasteRow = PasteRow + 1

This was to make sure the next row was pasted below the current one. However when it was active, I got a blank line between each insert. I am guessing this is because Insert effectively creates a new row and pastes the data there, which shifts the row numbers down so this row is not needed. Am I correct?

Secondly, this takes a little while to run and I keep seeing suggestions around optimising code, so any comments no how I have structured this would be most welcome, as I am keen to learn VBA as much as I can.

Thanks!

 

[mohadin]

Hi
Try

Sub MoveNoInvoicesNumber()
'A Sub to deal with intrastat lines with no invoices
'Assumption = will be removed
    Dim TableRows As Long, PasteRow As Long, Counter As Long, InvoiceColumn As Range, InvoiceNumber As Long
    Dim Table As ListObject
[COLOR=#ff0000]    Application.ScreenUpdating = False[/COLOR]
    Set ws1 = Sheets("2. Final Data")
    ws1.Activate
    With ws1
        TableRows = .Cells(Rows.Count, 1).End(xlUp).Row
        Set InvoiceColumn = .Range("A1:Z1").Find("Invoice")
        InvoiceNumber = InvoiceColumn.Column
    End With
    'Remove Table setting for the Data
    For Each Table In ws1.ListObjects
        Table.Unlist
    Next Table
    Cells(TableRows + 2, 1) = "Lines Removed From Intrastat - No Invoice Number"
    Cells(TableRows + 2, 1).Font.Bold = True
    PasteRow = TableRows + 4
    For Counter = TableRows To 2 Step -1
        If ws1.Cells(Counter, InvoiceNumber).Value = "" Then
            ws1.Rows(Counter).EntireRow.Cut
            ws1.Rows(PasteRow).Insert
            'PasteRow = PasteRow + 1
        End If
    Next Counter
[COLOR=#ff0000]     Application.ScreenUpdating = True[/COLOR]
End Sub

 

[TheRedCardinal]

That simple huh?
I do have that entry in a separate sub earlier on in the sheet, but I've turned off while I'm debugging.

Thanks!