Consulting

Results 1 to 3 of 3

Thread: Optimizing my VBA Code for faster speeds

  1. #1

    Optimizing my VBA Code for faster speeds

    Hello,
    I was wondering if someone could look at my VBA code and see if there are any ways that I can optimize it to perform at the fastest speed possible. Thanks for your help

    [VBA]
    Sub corporate()
    '
    ' corporate Macro
    '

    '

    Sheets("Network Selection Page").Select
    Sheets("Manage Reciepts Report (Raw)").Visible = True
    Sheets("Manage Reciepts Report (Raw)").Select
    Range("AX1").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("AT11").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Division Report").Visible = True
    Sheets("Division Report").Select
    Range("C3").Select
    Sheets("Network Selection Page").Visible = False

    'Insert blank rows after Cardholders

    Dim i As Long, CardholdersValue As Long, ApproversValue As Long, CurntCel As Range
    Application.ScreenUpdating = False
    Set CurntCel = ActiveCell
    CardholdersValue = ActiveSheet.Range("M1").Value
    ApproversValue = ActiveSheet.Range("N1").Value
    If ApproversValue Then
    Rows("12:" & 12 + (ApproversValue - 1)).Select
    Selection.Insert Shift:=x1Down
    End If
    With Selection
    For i = 1 To .Rows.Count
    .Rows(i).Cells(1).Value = "N" & i
    Next i
    End With

    'Paste Format for the cells

    Rows("11").Copy
    Rows("12:" & 12 + (ApproversValue - 1)).Select
    Selection.PasteSpecial -4122

    If CardholdersValue Then
    Rows("7:" & 7 + (CardholdersValue - 1)).Select
    Selection.Insert Shift:=x1Down
    End If
    With Selection
    For i = 1 To .Rows.Count
    .Rows(i).Cells(1).Value = "N" & i
    Next i
    End With

    'Paste Format for the Cells

    Rows("6").Copy
    Rows("7:" & 7 + (CardholdersValue - 1)).Select
    Selection.PasteSpecial -4122




    CurntCel.Select

    Application.ScreenUpdating = True
    Exit Sub



    End Sub
    [/VBA]

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    It seems to me your macro could be reduced to:
    [VBA]Sub Corporate()
    Dim i As Long, CardholdersValue As Long, ApproversValue As Long
    Application.ScreenUpdating = False
    Sheets("Network Selection Page").Visible = False
    Sheets("Manage Reciepts Report (Raw)").Range("AX1").Value = "2"
    'Insert blank rows after Cardholders
    With Sheets("Division Report")
    ApproversValue = .Range("N1").Value
    If ApproversValue > 0 Then
    .Rows("12:" & 12 + (ApproversValue - 1)).Insert Shift:=xlDown
    End If
    For i = 1 To ApproversValue
    .Cells(i + ApproversValue, 1).Value = "N" & i
    Next i
    'Paste Format for the cells
    .Rows("11").Copy
    .Rows("12:" & 12 + (ApproversValue - 1)).PasteSpecial -4122

    CardholdersValue = .Range("M1").Value
    If CardholdersValue > 0 Then
    Rows("7:" & 7 + (CardholdersValue - 1)).Insert Shift:=xlDown
    End If
    For i = 1 To CardholdersValue
    .Cells(i + CardholdersValue, 1).Value = "N" & i
    Next i
    'Paste Format for the Cells
    Rows("6").Copy
    Rows("7:" & 7 + (CardholdersValue - 1)).PasteSpecial -4122
    .Range("C3").Select
    Application.ScreenUpdating = True
    End With
    End Sub[/VBA]
    Note that everything is done without anything being selected (except for C3 at the end, which it seems you want to leave as the selected cell). It is far more efficient that way.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    Quote Originally Posted by macropod
    It seems to me your macro could be reduced to:
    [vba]Sub Corporate()
    Dim i As Long, CardholdersValue As Long, ApproversValue As Long
    Application.ScreenUpdating = False
    Sheets("Network Selection Page").Visible = False
    Sheets("Manage Reciepts Report (Raw)").Range("AX1").Value = "2"
    'Insert blank rows after Cardholders
    With Sheets("Division Report")
    ApproversValue = .Range("N1").Value
    If ApproversValue > 0 Then
    .Rows("12:" & 12 + (ApproversValue - 1)).Insert Shift:=xlDown
    End If
    For i = 1 To ApproversValue
    .Cells(i + ApproversValue, 1).Value = "N" & i
    Next i
    'Paste Format for the cells
    .Rows("11").Copy
    .Rows("12:" & 12 + (ApproversValue - 1)).PasteSpecial -4122

    CardholdersValue = .Range("M1").Value
    If CardholdersValue > 0 Then
    Rows("7:" & 7 + (CardholdersValue - 1)).Insert Shift:=xlDown
    End If
    For i = 1 To CardholdersValue
    .Cells(i + CardholdersValue, 1).Value = "N" & i
    Next i
    'Paste Format for the Cells
    Rows("6").Copy
    Rows("7:" & 7 + (CardholdersValue - 1)).PasteSpecial -4122
    .Range("C3").Select
    Application.ScreenUpdating = True
    End With
    End Sub[/vba]
    Note that everything is done without anything being selected (except for C3 at the end, which it seems you want to leave as the selected cell). It is far more efficient that way.
    That worked much better. Thanks for your help macropod

Posting Permissions

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