VBA adding blank lines when range copied

Afro_Cookie

New Member
Joined
Mar 17, 2020
Messages
46
Office Version
  1. 365
Platform
  1. Windows
I had some help with some code from this thread ( Macro crashes with button, works perfectly if run line by line ) and have modified it slightly since then, see below.

When I run it, it duplicates the number of lines I have but makes them blank. I added a special cells portion to delete the data in a column with no data, but it does not seem to be working.

Can someone please help me delete the blank rows that are added or identify why they are being added?


VBA Code:
Sub S0rt()

Dim tbl As Range
Set tbl = Sheets("WSG0106_CON10170").AutoFilter.Range
Set tbl = tbl.Resize(tbl.Rows.Count - 1)
Set tbl = tbl.Offset(1)

    Sheets("WSG0106_CON10170").Select
    Range("B:C, E:E").ClearContents
    Range("A:A").Delete
    Range("AC:AC").Delete
    Columns(5).Insert
    
    tbl.Copy Sheets("Table").Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0)
       
    ActiveWorkbook.Queries("WSG0106_CON10170").Delete
    Sheets("WSG0106_CON10170").Delete
    
    On Error Resume Next
    Sheets("Table").Select
    Application.ScreenUpdating = False
    Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
    
End Sub
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,360
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
If you want to delete an entire row if a cell in column C is blank then:

VBA Code:
Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,638
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
   Application.ScreenUpdating = False
   With Sheets("Table")
      With .Range("C1", .Range("C" & Rows.Count).End(xlUp))
         .Value = .Value
         On Error Resume Next
         .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
         On Error GoTo 0
      End With
   End With
   Application.ScreenUpdating = True
 
Solution

Afro_Cookie

New Member
Joined
Mar 17, 2020
Messages
46
Office Version
  1. 365
Platform
  1. Windows
@Fluff @johnnyL
Thank you both for your replies! Muchly appreciated.

Both options work in test and now I'm curious, would one code be more favourable over the other?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,638
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If your code didn't work, then I don't see how the change suggested by JohnnyL could make any difference. :unsure:
However if they both work, use which ever you prefer.
 

Afro_Cookie

New Member
Joined
Mar 17, 2020
Messages
46
Office Version
  1. 365
Platform
  1. Windows
I did further testing with actual data and the error still occurred. After adding in Fluff's modifications it resolved itself. Thanks @Fluff

Below is the final code I'm using.

VBA Code:
Sub Foot()

Dim tbl As Range
Set tbl = Sheets("WSG0106_CON10170").AutoFilter.Range
Set tbl = tbl.Resize(tbl.Rows.Count - 1)
Set tbl = tbl.Offset(1)

    Sheets("WSG0106_CON10170").Select
    Range("B:C, E:E").ClearContents
    Range("A:A").Delete
    Range("AC:AC").Delete
    Columns(5).Insert
    
    tbl.Copy Sheets("Table").Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0)
       
    ActiveWorkbook.Queries("WSG0106_CON10170").Delete
    Sheets("WSG0106_CON10170").Delete
  
' Thanks Fluff for the updated error checking code.  
   Application.ScreenUpdating = False
   With Sheets("Table")
      With .Range("Y4", .Range("Y" & Rows.Count).End(xlUp))
         .Value = .Value
         On Error Resume Next
         .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
         On Error GoTo 0
      End With
   End With
   Application.ScreenUpdating = True
    
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
62,638
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Forum statistics

Threads
1,141,816
Messages
5,708,746
Members
421,588
Latest member
Wawie

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top