How to speed up a macro

[kelly mort]

Hello All,
I have this code and I wanna ask if there is a way to speed it up. It takes longer than I expected to display the msgbox after the next i. thanks
kelly

Private Sub CmdAdd_Click()
    Dim ans As String, anss As Date
    sht = CmbClass.Value
    On Error GoTo errHandler
    If Rw2.Text = "" Or Rw5.Text = "" Then
    MsgBox "Fields empty." & vbCrLf & _
    "Fill the fields:" , _
    vbInformation, "Blank Fields Alert"
    Exit Sub
    Else

    If WorksheetFunction.CountIf(Sheets(sht).Range("C7:C110"), Me.Rw2.Text) > 0 Then
    MsgBox "Duplicate name alert"
    Exit Sub
    End If
    End If
    
    With Sheets(sht)
    If MsgBox("are you sure?” _
, vbYesNo + vbDefaultButton2 + vbQuestion, "Add this data?") = vbNo Then Exit Sub
    Application.ScreenUpdating = False
    Set Drng = .Range("B7")
    Set lrRng = .Cells(.Rows.Count, Drng.Column).End(xlUp).Offset(1, 0)
    lrRng.Value = Application.Max(Drng.EntireColumn) + 1
    lrRng.Offset(0, 1).Value = Rw2.Value
    lrRng.Offset(0, 2).Value = Rw3.Value
    lrRng.Offset(0, 3).Value = Rw4.Value
    lrRng.Offset(0, 4).Value = CDate(Rw5.Value)
    
    For i = 5 To 22
        lrRng.Offset(0, i).Value = Controls("Rw" & i + 1).Value
    Next i
    MsgBox "Data sent successfully"  _
, vbInformation, "Data added "
    
    SortIt
    Rw1.Value = ""
    Rw2.Value = ""
    Rw3.Value = ""
    For i = 5 To 23
    Controls("Rw" & i).Value = ""
    Next i
    End With
    
    Nroll.Text = Sheet2.Range("C12").Text
    NrollOption.Text = Sheet2.Range("H11").Text
    CmdNext.Enabled = False
    CmdBack.Enabled = False
    CmdPrintThis.Enabled = False
    CmdPrintMore.Enabled = True
    Application.ScreenUpdating = True
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "There was an error", vbInformation, "Error Alert"
End Sub

 

[ukmikeb]

Hi

The use of Offset is probably slowing the macro.

You know your target row so why not use Cells(Targetrow, column).Value = .....

Also, you are using If ..Else ..If ..End If ..End If unnecessarily in :-

    If Rw2.Text = "" Or Rw5.Text = "" Then
    MsgBox "Fields empty." & vbCrLf & _
    "Fill the fields:" , _
    vbInformation, "Blank Fields Alert"
    Exit Sub
    Else

    If WorksheetFunction.CountIf(Sheets(sht).Range("C7:C110"), Me.Rw2.Text) > 0 Then
    MsgBox "Duplicate name alert"
    Exit Sub
    End If
    End If

where :-

    If Rw2.Text = "" Or Rw5.Text = "" Then
    MsgBox "Fields empty." & vbCrLf & _
    "Fill the fields:" , _
    vbInformation, "Blank Fields Alert"
    Exit Sub
     End If


    If WorksheetFunction.CountIf(Sheets(sht).Range("C7:C110"), Me.Rw2.Text) > 0 Then
    MsgBox "Duplicate name alert"
    Exit Sub
    End If

would achieve the same outcome.

hth

 

[kelly mort]

Okay thank you mike. The issue is that i am now learning and there are some stuffs that i am not yet cool with. So i will be glad if you fix that target thing into my code for me. I have no idea what that means. I wrote this code through serries of tutorials. Thank you
Kelly

 

[ukmikeb]

    Dim Drng as Range, lrRng as Range
    Dim TgtRw as Long
    Set Drng = .Range("B7")
    Set lrRng = .Cells(.Rows.Count, Drng.Column).End(xlUp).Offset(1, 0)
    TgtRw = lrRng.Row 

'    In the following code I have replaced lrRng with Cells(TgtRw, Drng.Column) and then adjusted the Drng.Column part as necessary for the offset
   Cells(TgtRw, Drng.Column).Value = Application.Max(Drng.EntireColumn) + 1
   Cells(TgtRw, Drng.Column + 1).Value = Rw2.Value
   Cells(TgtRw, Drng.Column +2).Value = Rw3.Value
   Cells(TgtRw, Drng.Column + 3).Value = Rw4.Value
   Cells(TgtRw, Drng.Column + 4).Value = CDate(Rw5.Value)
    
    For i = 5 To 22
        Cells(TgtRw, Drng.Column + i).Value = Controls("Rw" & i + 1).Value
    Next i

hth

 

[kelly mort]

In cannot find where the data is sent to. It does not show up on the sheet

 

[ukmikeb]

Sorry, in the code I have provided change Cells to .Cells

 

[kelly mort]

Oh okay thank you. However the speed is the same as before. 3 seconds to display the message box. Maybe the speed of 3 seconds is cool. I was looking for something quicker. Haha

 

[kelly mort]

Maybe turning all calculations off and then turn them on later will add more speed. How do i turn them off and on??
Kelly

 

[tonyyy]

kelly mort,

You might consider changing the following line...

lrRng.Value = Application.Max(Drng.EntireColumn) + 1

to

lrrng.Value = Application.Max(Range(drng, lrrng.Offset(-1, 0))) + 1

Cheers,

tonyyy

 

[kelly mort]

Hi Tonyyy,
Thanks very much for the line. I still have the same time interval of 3 seconds. So i am thinking it might be the calculations that is slowing things down. Because the workbook contains a lot of formulas.
How do i turn the calculations off and on?
Thanks
Kelly