2 subs in one delete entire row and copy range of data based on col A being populated

setanta

New member
Joined
May 7, 2013
Messages
11
Reaction score
0
Points
0
Hi All, I was wondering if someone could help please.

I have 2 subs, one that deletes entire rows if column A is empty and the other that copies a range of data
if A is populated. I would like to combine the 2 subroutines below into one file if possible as when I run them
they take an age to run when there is no computation to be done i.e. when A=B.

I would like to run one or the other i.e.
1. if No. of populated Rows in Col A < No. of populated Rows in Col B Run delrows5
2. No. of populated Rows in Col A > No. of populated Rows in Col B Run CopyFormulae3.
3. No. of populated Rows in Col A = No. of populated Rows in Col B Exit Sub.
Please advise

Sub CopyFormulae3()
Dim i As Long
Application.ScreenUpdating = False
On Error GoTo ErrTrap
i = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Range("B9:AC" & i).FillDown
Exit Sub
ErrTrap:
MsgBox Format("CopyFormula failed!")
Application.ScreenUpdating = True
End Sub

Sub delrows5()
Application.ScreenUpdating = False
On Error GoTo ErrTrap
Sheets("Sheet1").Range("A9:A65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Exit Sub
ErrTrap:
MsgBox Format("CopyFormula failed!")
Application.ScreenUpdating = True
End Sub
 
Last edited:
Code:
sub all()
LRA = Range("A" & Rows.Count).End(xlUp).Row
LRB = Range("B" & Rows.Count).End(xlUp).RowIf LRA < LRB then 
  call delrows5
elseif LRA > LRB then
  call CopyFormulae3
end sub

Sub CopyFormulae3()
Dim i As Long
 Application.ScreenUpdating = False
 On Error GoTo ErrTrap
 i = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
 Range("B9:AC" & i).FillDown
 Exit Sub
 ErrTrap:
 MsgBox Format("CopyFormula failed!")
 Application.ScreenUpdating = True
 End Sub

 Sub delrows5()
 Application.ScreenUpdating = False
 On Error GoTo ErrTrap
 Sheets("Sheet1").Range("A9:A65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 Exit Sub
 ErrTrap:
 MsgBox Format("CopyFormula failed!")
 Application.ScreenUpdating = True
 End Sub
 
Back
Top