Code to delete Blank Rows

[howard]

I have the following code to delete blank rows on sheets "Output Accounts" and "Input Accounts" as well as to insert headings in A1 & B2 on these sheets

When Running the code it is deleting all the rows on sheet "Output accounts" and not doing anything on sheet "Input accounts"

After running the Macro the sheet output accounts looks like this

Excel 2012
	A	B
1		Amount
2	Account Number
3
4
5
6
7
Output Accounts

See my code below

It would be appreciated if someone could assist me

 Sub Remove_Blanks()
Dim Lr As Long
Lr = Cells(Rows.Count, "A").End(xlUp).Row


With Sheets("Output Accounts")
   With Range("A1:B" & Lr)
    .SpecialCells(xlCellTypeBlanks).Select
    .EntireRow.Delete
    With Range("A1")
    .EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = "Account Number"
    With Range("B1")
    .FormulaR1C1 = "Amount"
    With Range("A:A")
    .EntireColumn.AutoFit
     End With
       End With
         End With
           End With
             End With
    With Sheets("Input Accounts")
    
    
    With Range("A1:B" & Lr)
    .SpecialCells(xlCellTypeBlanks).Select
    .EntireRow.Delete
    With Range("A1")
    .EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = "Account Number"
    With Range("B1")
    .FormulaR1C1 = "Amount"
    With Range("A:A")
    .EntireColumn.AutoFit
     End With
       End With
         End With
           End With
             End With
   With Sheets("Extracted Data")
   With Range("A1").Activate
     End With
       End With
       
End Sub [\code]

 

[Andrew Poulsom]

In a With ... End With construct you need to precede calls to the object's properties/methods with a dot qualifier. For example:

With .Range("A1:B" & Lr)

If you don't the ActiveSheet will be used.

 

[howard]

Hi Peter

Thanks for the help.

When running the code on sheet "Extracted Data" all the rows are being deleted


See Sample Data Below

Excel 2012
	A	B
1	122215	-1903.5
2	125915	-266.49
3
4	197415	502.64
5	125915	70.38
6
7	174040	701.01
8	125915	0.19
9
10	125915	0.19
11	125915	21.39
12
13	125915	21.39
14	125915	98.14
15
16	153810	-209.07
17	125925	-29.27
18
19	133810	-1911.1
20	125925	-267.56
Extracted Data

See my amended code below

It would be appreciated if you would correct

 Sub Remove_Blanks()
Dim Lr As Long
Lr = Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Extracted Data")
   With .Range("A1:B" & Lr)
    .SpecialCells(xlCellTypeBlanks).Select
    .EntireRow.Delete
   End With
     End With
With Sheets("Output Accounts")
  
    With .Range("A1")
    .EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = "Account Number"
    With .Range("B1")
    .FormulaR1C1 = "Amount"
    With .Range("A:A")
    .EntireColumn.AutoFit
    
       End With
         End With
           End With
             End With
    With Sheets("Input Accounts")
    
    
    
    With .Range("A1")
    .EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    .FormulaR1C1 = "Account Number"
    With .Range("B1")
    .FormulaR1C1 = "Amount"
    With Range("A:A")
    .EntireColumn.AutoFit
    
       End With
         End With
           End With
             End With
   With Sheets("Extracted Data")
   With Range("A1").Activate
     End With
       End With
       
End Sub

 

[Andrew Poulsom]

This:

    .SpecialCells(xlCellTypeBlanks).Select
    .EntireRow.Delete

should be one line:

    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[hiker95]

howard,

How about something like this?


Sample raw data in worksheet Extracted Data:

Excel 2007
	A	B
1	122215	-1903.5
2	125915	-266.49
3
4	197415	502.64
5	125915	70.38
6
7	174040	701.01
8	125915	0.19
9
10	125915	0.19
11	125915	21.39
12
13	125915	21.39
14	125915	98.14
15
16	153810	-209.07
17	125925	-29.27
18
19	133810	-1911.1
20	125925	-267.56
21
Extracted Data

After the updated macro:

Excel 2007
	A	B
1	Account Number	Amount
2	122215	-1903.5
3	125915	-266.49
4	197415	502.64
5	125915	70.38
6	174040	701.01
7	125915	0.19
8	125915	0.19
9	125915	21.39
10	125915	21.39
11	125915	98.14
12	153810	-209.07
13	125925	-29.27
14	133810	-1911.1
15	125925	-267.56
16
17
18
19
20
21
Extracted Data

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub Remove_Blanks_V2()
' hiker95, 09/07/2014, ME803780
Dim Lr As Long

Application.ScreenUpdating = False

With Sheets("Extracted Data")
  Lr = .Cells(Rows.Count, "A").End(xlUp).Row
  On Error Resume Next
  .Range("A1:B" & Lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Rows(1).Insert
  .Range("A1").Resize(, 2).Value = Array("Account Number", "Amount")
  .Columns(1).Resize(, 2).AutoFit
  .Activate
  .Range("A1").Select
End With

Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Remove_Blanks_V2 macro.

 

[hiker95]

howard,

And, with the other two worksheets added to the macro (based on your posted macro code):

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub Remove_Blanks_V3()
' hiker95, 09/07/2014, ME803780
Dim Lr As Long

Application.ScreenUpdating = False

With Sheets("Output Accounts")
  .Rows(1).Insert
  .Range("A1").Resize(, 2).Value = Array("Account Number", "Amount")
  .Columns(1).Resize(, 2).AutoFit
End With
             
With Sheets("Input Accounts")
  .Rows(1).Insert
  .Range("A1").Resize(, 2).Value = Array("Account Number", "Amount")
  .Columns(1).Resize(, 2).AutoFit
End With

With Sheets("Extracted Data")
  Lr = .Cells(Rows.Count, "A").End(xlUp).Row
  On Error Resume Next
  .Range("A1:B" & Lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Rows(1).Insert
  .Range("A1").Resize(, 2).Value = Array("Account Number", "Amount")
  .Columns(1).Resize(, 2).AutoFit
  .Activate
  .Range("A1").Select
End With

Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Remove_Blanks_V3 macro.

 

[howard]

Thanks for the help, much appreciated

 

[hiker95]

howard,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.