Very slow execution of Excel 2016 VBA codes

1

I'm having a case of slow vba code execution. I find it hard to believe because I have a quad-core Core i7 processor operating at 2.6 GHz.

In my workbook, I have an input form on a separate sheet to enter invoices into database (sheet "frmBienNhan"). Then on another sheet I summarize all entered invoices with a pivotable (sheet "rpt_LSGD"). I use the event BeforeDoubleClick in sheet "rpt_LSGD" to bring user to different sheets depending on where they click to facilitate navigation. All codes run fine but codes that related to the user form run extremely slow. It took about 8-10 seconds for them to fully executed.

I am just a beginner with Excel VBA I would highly appreciate any help.

The following code intercept where the user double click on the sheet and show them to the corresponding sheet. Part of this code run very slow.

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        Dim a As String, b As Range

        Application.ScreenUpdating = False

        If ActiveCell.row > 4 Then
            Select Case ActiveCell.Column
                Case Is = 4 'This column contain invoice number
                    'Take the user to Invoice input form to edit the invoice they just double-clicked on
                    a = ActiveCell.Value
                    With Sheets("frmBienNhan")
                        .Unprotect Password:="forsce15"
                        .Range("K9").Value = a
                        .Protect Password:="forsce15"
                    End With
                    Call layThTinBienNhan 'This sub entered all invoice data previously entered into the user form
                    Sheets("frmBienNhan").Select
'The code from this point forward run very quickly
                Case Is = 9
                    Select Case ActiveCell.Offset(0, 1).Value
                        Case Is = 0
                            'Copy ma bien nhan sang sheet phan cong nhiem vu
                            a = ActiveCell.Offset(0, -5).Value
                            Sheets("frmPhanCongNhVu").Range("L6").Value = a
                            'Xoa form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Range("N13:S32").ClearContents
                            'Chuyen sang form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Select
                        Case Is <> 0
                            'Copy ma bien nhan sang sheet phan cong nhiem vu
                            a = ActiveCell.Offset(0, -5).Value
                            Sheets("frmPhanCongNhVu").Range("L6").Value = a

                            'Xoa form phan cong nhiem vu
                            Sheets("frmPhanCongNhVu").Range("N13:S32").ClearContents

                            'Kiem tra xem bien nhan hien tai da duoc phan cong hay chua
                            If Sheets("frmPhanCongNhVu").Range("I13").Value = "N/A" Then
                                'Neu chua phan cong thi chuyen sang sheet phan cong
                                Sheets("frmPhanCongNhVu").Select
                            Else
                                'Neu da phan cong thi nhap du lieu cu vao form phan cong
                                For Each b In Sheets("frmPhanCongNhVu").Range("T13:T32")
                                    If b.Value <> "N/A" Then
                                        b.Offset(0, -6).Value = b.Offset(0, 0).Value 'TaiLieu
                                        b.Offset(0, -5).Value = b.Offset(0, 1).Value 'LoaiCongViec
                                        b.Offset(0, -6).Value = b.Offset(0, 2).Value 'NgThucHien
                                        b.Offset(0, -3).Value = b.Offset(0, 3).Value 'TrangTG
                                        b.Offset(0, -2).Value = b.Offset(0, 4).Value 'TrangVDM
                                        b.Offset(0, -1).Value = b.Offset(0, 5).Value 'NgayGiaoViec
                                    End If
                                Next b
                                'Chuyen sang form phan cong
                                Sheets("frmPhanCongNhVu").Select
                            End If
                    End Select
            End Select
        End If

        Application.ScreenUpdating = True
    End Sub

The following code update the user form with old invoice data so that they can edit that invoice. This code run very slow.

Sub layThTinBienNhan()
    Dim r As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False

'Clear form
    Set ws = Sheets("frmBienNhan")
    For Each r In ws.Range("C6:K36")
        If r.Locked = False Then
            r.Value = vbNullString
        End If
    Next r

'Copy old data to user form
    With ws
        .Range("D6").Value = .Range("L11").Value 'Khach hang
        .Range("D7").Value = .Range("M11").Value 'So DT
        .Range("D9").Value = .Range("Q6").Value 'Ghi chu
        .Range("I9").Value = .Range("Q9").Value 'Thanh toan
        .Range("D34").Value = .Range("N9").Value 'Gio giao
        .Range("D35").Value = .Range("O9").Value 'Ngay giao
        .Range("D36").Value = .Range("M9").Value 'Ngay nhan
    End With
    For Each r In ws.Range("L13:L32")
        If r.Value <> "N/A" Then
            With r
                .Offset(0, -9).Value = .Offset(0, 2).Value 'Ten ho so
                .Offset(0, -8).Value = .Offset(0, 3).Value 'Ngon ngu
                .Offset(0, -7).Value = .Offset(0, 4).Value 'Trang dich
                .Offset(0, -6).Value = .Offset(0, 5).Value 'Don gia dich
                .Offset(0, -5).Value = .Offset(0, 6).Value 'So luong nhan ban
            End With
        End If
    Next r

    Application.ScreenUpdating = True
End Sub

This code is used to update invoice data. This code run a little bit slow.

Sub capnhatBienNhan()
    Dim a As Range
    Dim r As Long

    Application.ScreenUpdating = False
    Sheets("frmBienNhan").Unprotect Password:="forsce15"

    r = Sheets("frmBienNhan").Range("R9").Value

'Update invoice info
    With Sheets("datLSGD")
        .Cells(r, 4).Value = Sheets("frmBienNhan").Range("T2").Value 'MaQLy
        .Cells(r, 5).Value = Sheets("frmBienNhan").Range("U2").Value 'NgayGD
        .Cells(r, 6).Value = Sheets("frmBienNhan").Range("V2").Value 'GioGiao
        .Cells(r, 7).Value = Sheets("frmBienNhan").Range("W2").Value 'NgayGiao
        .Cells(r, 8).Value = Sheets("frmBienNhan").Range("X2").Value 'Ghichu
        .Cells(r, 9).Value = Sheets("frmBienNhan").Range("Y2").Value 'ThanhToan
    End With

'Update invoice items info
    On Error Resume Next
    For Each a In Sheets("frmBienNhan").Range("L13:L32")
        If a <> "N/A" Then
            r = a.Value
            With Sheets("datChiTietBN")
                .Cells(r, 2).Value = a.Offset(0, -11).Value 'MaBNEntry
                .Cells(r, 3).Value = a.Offset(0, -9).Value 'TenHoSo
                .Cells(r, 4).Value = a.Offset(0, -8).Value 'NgonNgu
                .Cells(r, 5).Value = a.Offset(0, -7).Value 'SLDich
                .Cells(r, 6).Value = a.Offset(0, -6).Value 'DonGiaDich
                .Cells(r, 7).Value = a.Offset(0, -5).Value 'SLBanSao
                .Cells(r, 8).Value = a.Offset(0, -4).Value 'DonGiaBanSao
                .Cells(r, 9).Value = a.Offset(0, -3).Value 'SLCongChung
                .Cells(r, 10).Value = a.Offset(0, -2).Value 'TienCongChung
            End With
        End If
    Next a
    a = MsgBox("Cap nhat thanh cong", vbOKOnly, "Cap nhat du lieu bien nhan")

    Sheets("frmBienNhan").Protect Password:="forsce15"
    Application.ScreenUpdating = True
End Sub

The following code run when user hit the "Update" button on the user form. It will check whether the user is creating a new invoice or updating an existing one and take corresponding action. This code runs quite slow.

Sub nhapBienNhan()
Dim lastRow As Long
Dim a As Range

Application.ScreenUpdating = False

'Unlock sheet
Sheets("frmBienNhan").Unprotect Password:="forsce15"

If Sheets("frmBienNhan").Range("H1").Value <> 0 Then
    MsgBox "Cac o co tieu de mau do khong duoc de trong."
    Exit Sub

ElseIf Sheets("frmBienNhan").Range("K9").Value <> vbNullString Then
    Call capnhatBienNhan

Else
    'creating new invoice items data
    For Each a In Sheets("frmBienNhan").Range("C13:C32")
        If a.Value <> vbNullString Then
            lastRow = Sheets("frmBienNhan").Range("Q2").Value
            With Sheets("datChiTietBN")
                .Cells(lastRow, 2).Value = a.Offset(0, -2).Value 'MaBNEntry
                .Cells(lastRow, 3).Value = a.Offset(0, 0).Value 'TenHoSo
                .Cells(lastRow, 4).Value = a.Offset(0, 1).Value 'NgonNgu
                .Cells(lastRow, 5).Value = a.Offset(0, 2).Value 'SLDich
                .Cells(lastRow, 6).Value = a.Offset(0, 3).Value 'DonGiaDich
                .Cells(lastRow, 7).Value = a.Offset(0, 4).Value 'SLBanSao
                .Cells(lastRow, 8).Value = a.Offset(0, 5).Value 'DonGiaBanSao
                .Cells(lastRow, 9).Value = a.Offset(0, 6).Value 'SLCongChung
                .Cells(lastRow, 10).Value = a.Offset(0, 7).Value 'TienCongChung
            End With
        End If
    Next a

    'Creating new invoice data
    lastRow = Sheets("frmBienNhan").Range("R2").Value
    With Sheets("datLSGD")
        .Cells(lastRow, 2).Value = Sheets("frmBienNhan").Range("Q4").Value 'TinhTrangBN
        .Cells(lastRow, 3).Value = Sheets("frmBienNhan").Range("S2").Value 'MaBN
        .Cells(lastRow, 4).Value = Sheets("frmBienNhan").Range("T2").Value 'MaKhachHang
        .Cells(lastRow, 5).Value = Sheets("frmBienNhan").Range("U2").Value 'NgayGD
        .Cells(lastRow, 6).Value = Sheets("frmBienNhan").Range("V2").Value 'GioGD
        .Cells(lastRow, 7).Value = Sheets("frmBienNhan").Range("W2").Value 'NgayGiao
        .Cells(lastRow, 8).Value = Sheets("frmBienNhan").Range("X2").Value 'GhiChu
        .Cells(lastRow, 9).Value = Sheets("frmBienNhan").Range("Y2").Value 'ThanhToan
    End With

    Sheets("frmbiennhan").Range("K9").Value = Sheets("frmBienNhan").Range("S2").Value

    MsgBox "Da luu bien nhan", vbOKOnly, "Nhap bien nhan moi"

    'Lock sheet
    ActiveSheet.Protect Password:="forsce15"
End If

Application.ScreenUpdating = True
End Sub

Thank you guys for your time and effort. Let me know if you need more clarification or samples.

Chau Nguyen

Posted 2016-02-29T10:30:02.923

Reputation: 25

1Even if your question is not explicitly off topic here, I think you could get better answers on stackoverflow or code review stackexchange. – Máté Juhász – 2016-02-29T10:41:09.007

Thank you for pointing that out, I did not notice that I was redirected to superuser when posting this question. I intended this question for stackoverflow. :) – Chau Nguyen – 2016-02-29T14:59:21.143

Answers

0

The problem is that you have loops with many many iterations due to a big range.

VBA just is not fast when you create loops that walk past lots of cells.

They are:

For Each a In Sheets("frmBienNhan").Range("C13:C32")

It is likely going to be faster if you don't use .range but instead do a simple: 

For a = 13 to 32

And

if cells(12,a) <> vbNullString then

LPChip

Posted 2016-02-29T10:30:02.923

Reputation: 42 190

Asked: 2016-02-29T10:30:02.923

Viewed: 3 351 times

Active: 2016-02-29T11:25:07.077