VBA script to format an Excel sheet

I'm making an app in Excel-VBA, but when I have more than 50,000 records, my code runs very slow and the formatting takes about 33 seconds.

```
Application.Interactive = False
Application.EnableEvents = False
Application.ScreenUpdating = False
'--------------- Tao Bien ------------------------------------------
Dim Dulieu() As Variant
Dim lastrow As Integer
Dim lastrowSC As Integer
Dim i, j As Integer
Dim NoDk, CoDk As Double
Dim PSNo As Double
Dim PSCo As Double
Dim NoCk As Double
Dim CoCk As Double
Dim TempArray() As Variant
Dim TheRange As Range
Dim Size As Integer
Dim TempArrayDao() As Variant
Dim lastrowTK As Integer
Dim TaiKhoan() As Variant
Dim FromDate As Date
Dim ToDate As Date

'--------------------Do Toc Do--------------------------------------
Dim Starttime As Double
Dim Code1 As Double
Dim Code2 As Double
Dim Code3 As Double
Dim Code4 As Double
Dim Code5 As Double
Dim Code6 As Double
Dim Code7 As Double
Starttime = Timer

'--------------- Xong Tao Bien --------------------------------------
NoDk = 0
CoDk = 0
PSNo = 0
PSCo = 0
NoCk = 0
CoCk = 0
lastrow = Sheet8.Cells(Rows.Count, "I").End(xlUp).Row

'Them so du dau ky----------------------------------------------------

lastrowTK = Sheet7.Cells(Rows.Count, "A").End(xlUp).Row
TaiKhoan = Sheet7.Range("A2:H" & lastrowTK)

For i = LBound(TaiKhoan) To UBound(TaiKhoan)
If Sheet26.Cells(4, 4).Text = TaiKhoan(i, 1) Then
NoDk = TaiKhoan(i, 3)
CoDk = TaiKhoan(i, 4)
Sheet26.Cells(5, 3).Value = "Tên tài kho" & ChrW(7843) & "n : " & TaiKhoan(i, 2)
Exit For
End If

Next

Code1 = Round(Timer - Starttime, 2)
'----------------------------------------------------------------------
Dim NoCongDon As Double
Dim CoCongDon As Double

Sheet26.Select
' Dua Du lieu vao Array Dulieu
Dulieu = Sheet8.Range("G2:N" & lastrow).Value
FromDate = Sheet26.Cells(6, 3).Value
ToDate = Sheet26.Cells(7, 3).Value
Size = 1
ReDim TempArray(1 To 6, 1 To Size)
Dim tk As String
tk = Sheet26.Cells(4, 4).Text
For

I thought about applying filters to your KTSC data but, working through your code, I realised that wasn't an option due to valid rows coming from both columns L and M.

The first part of your code using arrays to juggle the data is quite fast and I can't see any significant speed gains by changing its logic. I did however move your With Sheets26 from within the formatting code to just below Dulieu = Sheet8.Range("G2:N" & lastrow).Value because that was the last call to any other sheet. I also moved your End With as far down your code as seemed logical.

Your formatting section had repeated calls to .VerticalAlignment = xlCenter and .HorizontalAlignment = xlCenter for different ranges. It seems that formatting 4 or 6 columns is just as fast as formatting 1. So I changed to code to use each formatting command once only. I did try formatting a single row (14) on SỔ CÁI and then copying the formats to all other rows and picked up about 0.2s

With 111 in D4 of SỔ CÁI this code runs for me in 1.41s compared with the 7.39s I mentioned in comments.

So:

• try to use logic such that formatting commands are applied once to the broadest range possible

• Use With..EndWith constructs in the broadest span possible. It's OK to reference other objects/sheets/ranges explicitly within the construct.

Here's the code which should run in < 6s on your machine:

Sub InSoCai()

'Application.Interactive = False I don't think there is any speed gain using this
Application.EnableEvents = False
Application.ScreenUpdating = False
'--------------- Tao Bien ------------------------------------------
Dim Dulieu() As Variant
Dim lastrow As Integer
Dim lastrowSC As Integer
Dim i As Integer
Dim j As Integer
Dim NoDk As Double
Dim CoDk As Double
Dim PSNo As Double
Dim PSCo As Double
Dim NoCk As Double
Dim CoCk As Double
Dim TempArray() As Variant
Dim TheRange As Range
Dim Size As Integer
Dim TempArrayDao() As Variant
Dim lastrowTK As Integer
Dim TaiKhoan() As Variant
Dim FromDate As Date
Dim ToDate As Date

'--------------------Do Toc Do--------------------------------------
Dim Starttime As Double
Dim Code1 As Double
Dim Code2 As Double
Dim Code3 As Double
Dim Code4 As Double
Dim Code5 As Double
Dim Code6 As Double
Dim Code7 As Double
Starttime = Timer

'--------------- Xong Tao Bien --------------------------------------
NoDk = 0
CoDk = 0
PSNo = 0
PSCo = 0
NoCk = 0
CoCk = 0
lastrow = Sheet8.Cells(Rows.Count, "I").End(xlUp).Row

'Them so du dau ky----------------------------------------------------

lastrowTK = Sheet7.Cells(Rows.Count, "A").End(xlUp).Row
TaiKhoan = Sheet7.Range("A2:H" & lastrowTK)

For i = LBound(TaiKhoan) To UBound(TaiKhoan)
    If Sheet26.Cells(4, 4).Text = TaiKhoan(i, 1) Then
        NoDk = TaiKhoan(i, 3)
        CoDk = TaiKhoan(i, 4)
        Sheet26.Cells(5, 3).Value = "Tên tài kho" _
            & ChrW(7843) & "n : " & TaiKhoan(i, 2)
        Exit For
    End If
Next

Code1 = Round(Timer - Starttime, 2)
'----------------------------------------------------------------------
Dim NoCongDon As Double
Dim CoCongDon As Double

' Dua Du lieu vao Array Dulieu
Dulieu = Sheet8.Range("G2:N" & lastrow).Value
With Sheet26
    FromDate = .Cells(6, 3).Value 'Does this date ever change
    ToDate = .Cells(7, 3).Value
    Size = 1
    ReDim TempArray(1 To 6, 1 To Size)
    Dim tk As String
    tk = .Cells(4, 4).Text
    For i = 1 To UBound(Dulieu)
        If StrComp(Left(tk, Len(Trim(tk))), _
            Left(Dulieu(i, 6), Len(Trim(tk))), vbTextCompare) = 0 _
        Or StrComp(Left(tk, Len(Trim(tk))), _
            Left(Dulieu(i, 7), Len(Trim(tk))), vbTextCompare) = 0 Then

            If (StrComp(Left(tk, Len(Trim(tk))), _
                Left(Dulieu(i, 6), Len(Trim(tk))), vbTextCompare) = 0) Then
                If Dulieu(i, 3)  0 Then
        NoDk = NoDk + NoCongDon - CoCongDon
        CoDk = 0
    Else
        CoDk = CoDk + CoCongDon - NoCongDon
        NoDk = 0
    End If
    .Range("E" & k).FormulaR1C1 = "=SUBTOTAL(9,R[-" & Size - 1 & "]C:R[-1]C)"
    .Range("F" & k).FormulaR1C1 = "=SUBTOTAL(9,R[-" & Size - 1 & "]C:R[-1]C)"
    PSNo = .Range("E" & k).Value
    PSCo = .Range("F" & k).Value
    .Cells(8, 5).Value = NoDk
    .Cells(8, 6).Value = CoDk
    .Cells(9, 5).Value = PSNo
    .Cells(9, 6).Value = PSCo
    If NoDk > 0 Then
        NoDk = NoDk + NoCongDon - CoCongDon
        CoDk = 0
    Else
        CoDk = CoDk + CoCongDon - NoCongDon
        NoDk = 0
    End If
    NoCk = NoDk - CoDk + PSNo - PSCo
    If NoCk > 0 Then
        CoCk = 0
    Else
        CoCk = -NoCk
        NoCk = 0
    End If
    .Cells(10, 5).Value = NoCk
    .Cells(10, 6).Value = CoCk
    .Range("E" & k + 1).Value = NoCk
    .Range("F" & k + 1).Value = CoCk
    .Select
    .Cells(1, 1).Select
End With

Code7 = Round(Timer - Starttime, 2)

Application.Interactive = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

StackExchange Code Review Q#108854, answer score: 4