PDA

View Full Version : VBA macro to delete all empty rows and columns



specialist
04-09-2015, 10:49 AM
Hello,

I'm in need of a macro that will delete all the empty lines and columns within the spreadsheet. I need all empty lines after (and including) line 17 and all empty columns after (and including) Column V. I want to be able to add this to the existing macro attached. Also, the deleting would have to be done before anything else withing the existing macro.

The manual way I would do this would be to select the first empty line after the data (Ctrl+Shift+arrow key down), right click and delete. Same process for the columns. Then I would run the macro below

Thank you


Sub CreateRebateFile()

Const TAB_DELIMITED = 3
Const EXCEL_WORKSHEET = 1

Dim msgResponse As Variant

On Error GoTo CreateRebateFile_Error


'** Save the workbook before creating the individual files
If ActiveWorkbook.Saved = False Then
msgResponse = MsgBox("Do you want to Save this Excel Workbook? (Recommended)", _
vbOKCancel + vbDefaultButton1 + vbQuestion, "Rebate File for SAP")
If msgResponse = vbOK Then
Application.Dialogs(xlDialogSaveAs).Show "", EXCEL_WORKSHEET
End If
End If

For Each Worksheet In Worksheets

Worksheet.Select

'** Offer to Save the Excel File
If Range("Customer_Number").Value > " " Then

If Range("Period_FROM").Value > " " And _
Range("Period_To").Value > " " Then


If Range("START_CELL").Value > " " Then

msgResponse = MsgBox("Would you like to Create the SAP Upload File for Worksheet: " _
& Worksheet.Name & " ?", _
vbOKCancel + vbDefaultButton1 + vbQuestion, _
"Rebate File for SAP")
If msgResponse = vbOK Then
Application.Dialogs(xlDialogSaveAs).Show "", TAB_DELIMITED
End If

Else

MsgBox "No Claims entered in Worksheet: " & Worksheet.Name, _
vbOKCancel + vbExclamation, "Rebate Save Error"
Range("START_CELL").Select
End If

Else

MsgBox "Rebate Period Incomplete or Invalid for Worksheet: " & Worksheet.Name, _
vbOKCancel + vbExclamation, "Rebate Save Error"
Range("Period_FROM").Select
End If
Else

MsgBox "Customer Number Missing in Worksheet: " & Worksheet.Name, _
vbOKCancel + vbExclamation, "Rebate Save Error"
Range("Customer_Number").Select
End If

Next

Exit Sub

CreateRebateFile_Error:


MsgBox "UnExpected Error Occurred During Conversion: " & vbCrLf & _
"#" & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, "Rebate File for SAP"

Err.Clear

Exit Sub



End Sub

Yongle
04-09-2015, 10:03 PM
Below is a macro for you to try.
Copy the macro into a test workbook placing your data into Sheet1 and run the macro
If ok then you can either run it as a standalone macro, or incorporate the code at the beginning of your macro, amending "Sheet1" to your worksheet's name in the line:

Set ws = Worksheets("sheet1")
I am assuming that there is only one worksheet to apply the code to from your comment
I'm in need of a macro that will delete all the empty lines and columns within the spreadsheet




Sub DeleteBlankRowsBlankColumns()

'declare variables and set worksheet
Dim i As Long, LastRow As Long, lastCol As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
'find last row and last column
LastRow = ws.Range("A1048576").End(xlUp).Row
lastCol = ws.Range("XFD1").End(xlToLeft).Column
'delete from bottom up ending at row 11
For i = LastRow To 11 Step -1
If WorksheetFunction.CountA(ws.Rows(i).EntireRow) = 0 Then
ws.Rows(i).Delete
Else
End If
Next i
'delete from right to left ending at column no 22 (ie V)
For i = lastCol To 22 Step -1
If WorksheetFunction.CountA(ws.Columns(i).EntireColumn) = 0 Then
ws.Columns(i).Delete
Else
End If
Next i

End Sub