Results 1 to 2 of 2

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

  1. #1

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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 05:44 PM.

  2. #2
    Acolyte patel's Avatar
    Join Date
    Feb 2014
    Location
    Italy
    Posts
    59
    Articles
    0
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •