VBA: Selecting only rows with data in a range

[forrad]

Hello all,

I am working on a spreadsheet, in which I have written a macro whereby it selects and cuts data within a defined range (in this case "K1:T1001") and pastes this to the first empty row in column A. Here is the specific line used in this macro:

If Not IsEmpty(MyCell) Then
ActiveSheet.Range("K1:T1001").Cut Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(2)
End If

I would like to use this macro for other similar spreadsheets where the range of rows to be selected may differ (however, the columns will always be K:T). I'm afraid I have reached my limit of knowledge with VBA to know how to select only cells containing data within this range.

Any help would be greatly appreciated!

 

[Joe4]

Welcome to the Board!

The first thing you need to figure out is which column you can use to determine where the data ends (that is, identify a column that will always be populated if a row has data).

You can then use that row to find that last row with data in it dynamically like this (using column K in this example):

LastRow = Cells(Rows.Count,"K").End(xlUp).Row

Then, you can dynamically set your range like this:

Range("K1:T" & LastRow)

 

[forrad]

Thank you for your reply, seems a promising start.

When I run this macro on the original spreadsheet, all seems well (I used column 'R' as the count indicator, as they is usually an extra row containing formula). Therefore, the line I adapted from your suggestion was like this:

LastRow = Cells(Rows.Count, "R").End(x1Up).Row

However, when I try to use this macro with other sheets, I receive a 'Run-time error 1004, Application defined or User defined error' message with the above line.

I have a copied my macro in full so as to give you a better idea of what it is I am trying to do with it.

 Sub ShiftCells()
    Select Case MsgBox("Can't Undo this Action. " & _
                       "Save Workbook First?", vbYesNoCancel)
        Case Is = vbYes
        ThisWorkbook.Save
        
        Case Is = vbCancel
        Exit Sub
    End Select

    Dim MyRange As Range
    Dim MyCell As Range
                        
    Set MyRange = ActiveSheet.Range("K:T")
    For Each MyCell In MyRange
    
    If Not IsEmpty(MyCell) Then
        LastRow = Cells(Rows.Count, "R").End(x1Up).Row
        ActiveSheet.Range("K1:T" & LastRow).Cut Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(2)
    End If
        
    For Each Column In Range("K:T").Rows
            If WorksheetFunction.CountA(Range("K:T").EntireColumn) = 0 Then
                Range("K:T").EntireColumn.Delete
            End If
    Next Column

    Next MyCell
    
End Sub

Many thanks for your help again, it is most appreciated

 

[Joe4]

It should be "xlUp", not "x1Up".
I think the font being used by the board when using code tags is making it look like a number "1" instead of a lower case "L".

 

[stefankemp]

This is wrong:

    For Each Column In Range("K:T").Rows
            If WorksheetFunction.CountA(Range("K:T").EntireColumn) = 0 Then
                Range("K:T").EntireColumn.Delete
            End If
    Next Column

Why do you want to test if the columns are empty? They should be empty because you have cut all the data from them. Just delete them all at once.

 

[forrad]

This is wrong:

    For Each Column In Range("K:T").Rows
            If WorksheetFunction.CountA(Range("K:T").EntireColumn) = 0 Then
                Range("K:T").EntireColumn.Delete
            End If
    Next Column

Why do you want to test if the columns are empty? They should be empty because you have cut all the data from them. Just delete them all at once.

I put this part in as there are empty columns ("B" & "D") that are blank by design and are necessary. I therefore have tried to avoid including anything that deletes ALL blank columns and only the specific columns to be cut and pasted. I'm sure my basic VBA knowledge means that it is a clumsy way to go about it, but that is the reasoning behind it.

Essentially, it is data produced by my company's payroll system that generates 10 columns of data repeated for as many clients as are included in the month's payroll (So the data in column 'A' is exactly the same as in column 'K', 'C' & 'M' and so forth). The purpose of the macro is to 'clean up' the data, converting it into one long list of 10 columns.

 

[stefankemp]

Remove the "For Each" and the "IF" statements and just delete columns K to T:

Range("K:T").EntireColumn.Delete

 

[forrad]

Remove the "For Each" and the "IF" statements and just delete columns K to T:

Range("K:T").EntireColumn.Delete

Thanks for the suggestions in cleaning up the macro, and sorry for the confusion with the font, was most embarrassing on my part.

This issue now is that it will not loop. I can run the macro as many times as I want, and it will perform the function of cutting, pasting and deleting empty columns once, but only once. I am stratching my head as to why it loops on the original worksheet, but when applied to another, the loops seemingly breaks.

 

[stefankemp]

You don't really need to loop:

LastRow = Cells(Rows.Count, "R").End(x1Up).Row
ActiveSheet.Range("K1:T"&LastRow).Cut Destination:=ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(2)

 

[forrad]

It has to loop as there are several blocks of data that need to be sorted into one series of continuous rows. So the idea of the macro is to cut and paste the data in columns K-T, delete the empty columns so the next block moves into that range, and repeat the process until the range is empty.