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 by setanta; 2014-03-28 at 06:44 PM.
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
Bookmarks