I need a Macro to Clean Unwanted Data (Rows and Columns) from a Spreadsheet

I have a spreadsheet, generated by Accounting, that I want to strip of its extra Excel subtotals and spaces and reduce to a data table for use in Access.

Essentially, I want to, via a macro, Delete Rows in a certain column that start with "%", Delete Rows in a certain column that are blank, and delete columns in a certain row that start with "Q"

Can anyone show me how to do this?

Thank you
Who is Participating?
mvidasConnect With a Mentor Commented:
Hi Rex,

Here you go, and you should be able to adapt it easily for any other future changes you have. Let me know if you have any questions.

Sub Rex85()
 Dim i As Long

 Application.ScreenUpdating = False 

'Change the row here accordingly (currently looking in row 3)
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Left(Cells(3, i).Text, 1) = "Q" Then
  End If
 'Change the column here according (currently looking at column D)
 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  If Left(Range("D" & i).Text, 1) = "%" Then
  End If
 'look in the used cells in a column and delete blank columns
 For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
  If Application.WorksheetFunction.CountA(Intersect(Columns(i), ActiveSheet.UsedRange)) = 0 Then
  End If

 Application.ScreenUpdating = True
End Sub

Open in new window

EDIT: toggled screen updating for less flicker, in case you didn't know to add it.
Alexander Eßer [Alex140181]Software DeveloperCommented:
Not as elegant as mvidas' solution, but maybe you want to give it a shot ;-)

Option Explicit

Sub cleanup()

Dim i, row As Long
Dim colummn As Long
Dim str_array() As String
Dim range_str As String

    ReDim str_array(0)
    row = 1
    Do While Cells(row, 1) <> "" ' here column 1 is used -> should be a column that is not empty throughout the entire sheet
        For i = 1 To 3 ' assuming the columns are fixed length, otherwise max column count has to be calculated per row
            If Mid(Cells(row, i), 1, 1) = "%" Or Mid(Cells(row, i), 1, 1) = "Q" Or Cells(row, i) = "" Then
                str_array(UBound(str_array)) = row & ":" & row
                ReDim Preserve str_array(UBound(str_array) + 1)
                Exit For
            End If
        Next i
        row = row + 1
    range_str = Join(str_array, ",")
    range_str = Mid(range_str, 1, Len(range_str) - 1)

End Sub

Open in new window

Rex85Author Commented:
Thank you both. I had just successfully tried mvidas' solution and was getting ready to close.


Rex85Author Commented:
Fantastic. Worked perfectly for what i asked.

Thank you!

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.