Clear Data From Rows under the (LastRow) in in Column A:A where a blank gap exists (Please help!)

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Hi Excel Community!

I'm having trouble with the following code for a day now. If someone could kindly help this would be great, thank you!

Basically I have a data range and there is some unnecessary data under the last row in the data set.

I have data in the cell range A1:F7 for example, and there is a consistent gap under column A:A under the last row. So I have used this as my unique identifier for the code.
But the code only works to delete a specific range based on the worksheet I have selected.

But I need it to loop through the worksheets and delete the data since the data in the different sheets have different row lengths. For example, the next sheet has data in the range A1:F20.

Screenshot.png


VBA Code:
Sub ClearRows()

Const NumOfRowClear = 100
Dim r As Range, lastrow As Long, ws As Worksheet


lastrow = ActiveSheet.Range("A1").End(xlDown).Row

For Each ws In ActiveWorkbook.Worksheets
Cells.UnMerge
Set r = ws.Range(ws.Cells(lastrow + 1, 1), ws.Cells(lastrow + NumOfRowClear, 10000))
r.ClearContents

Next ws

End Sub

My code includes 'unmerge' because some cells are merged so I unmerge first before running the VBA.

If anyone has any ideas, this would be fantastic! Thank you

Best regards
 

Attachments

  • Screentshot.png
    Screentshot.png
    12.9 KB · Views: 0

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,053
Office Version
  1. 2019
Platform
  1. Windows
See if this does what you need, please create a copy of your workbook for testing in order to avoid data loss if it doesn't work as expected.
VBA Code:
Sub ClearRows()

Dim r As Range, lastrow As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    ws.Cells.UnMerge
    Set r = ws.Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws

End Sub
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Hi Jason,

Thank you for the quick reply!
Unfortunately, I get a runtime error '1004' with this. 'Application-defined or object-defined error' :(
Do you know what may be causing this error? Thank you


See if this does what you need, please create a copy of your workbook for testing in order to avoid data loss if it doesn't work as expected.
VBA Code:
Sub ClearRows()

Dim r As Range, lastrow As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    ws.Cells.UnMerge
    Set r = ws.Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws

End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,053
Office Version
  1. 2019
Platform
  1. Windows
When you hit debug, which line was highlighted?

edit:- you can't unmerge if there are no merged cells, so that is most likely the cause, this should fix it
VBA Code:
Sub ClearRows()

Dim r As Range, lastrow As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    On Error Resume Next
    ws.Cells.UnMerge
    On Error GoTo 0
    Set r = ws.Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws

End Sub
 
Last edited:

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Thank you Jason, the section: Set r = ws.Range("A1").End(xlDown).Offset(1) comes up as an errror.
Some sheets have merged cells, some do not.

I tried your new code, still the same problem :( Very strange.




When you hit debug, which line was highlighted?

edit:- you can't unmerge if there are no merged cells, so that is most likely the cause, this should fix it
VBA Code:
Sub ClearRows()

Dim r As Range, lastrow As Long, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    On Error Resume Next
    ws.Cells.UnMerge
    On Error GoTo 0
Set r = ws.Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws

End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,053
Office Version
  1. 2019
Platform
  1. Windows
Are there any sheets with nothing below A1?
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Actually, Jason, I deleted the ("ws") from Set r = ws.Range("A1").End(xlDown).Offset(1) and it sort of works, but it doesn't seem to be dynamic.
It deletes the same selected range for each sheet like my code before, instead of finding the last row of each sheet and deleting the range below it dynamically each time.
Hmmm:unsure:

VBA Code:
Sub ClearRows()

Dim r As Range, lastrow As Long, ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    On Error Resume Next
    ws.Cells.UnMerge
    On Error GoTo 0
    Set r = Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws

End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,053
Office Version
  1. 2019
Platform
  1. Windows
It needs ws. in that line to make it dynamic. If there are sheets with nothing below A1 then this should do the trick,
VBA Code:
Sub ClearRows()Dim r As Range, ws As Worksheet
    On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
    ws.Cells.UnMerge
    Set r = ws.Range("A1").End(xlDown).Offset(1)
    r.Resize(100).EntireRow.Delete
Next ws
End Sub
It's not good practice to leave an error handle open, but as the code is not doing anything else it will work fine here.
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
11,053
Office Version
  1. 2019
Platform
  1. Windows
Are any of the sheets protected?

Having no data below A1 was the only way that I could get an error on the same line as you, but if a sheet is protected then it could have a similar effect.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,645
Messages
5,549,163
Members
410,902
Latest member
G Slim
Top