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 = FalseApplication.EnableEvents = FalseApplication.ScreenUpdating = False'--------------- Tao Bien ------------------------------------------Dim Dulieu() As VariantDim lastrow As IntegerDim lastrowSC As IntegerDim i, j As IntegerDim NoDk, CoDk As DoubleDim PSNo As DoubleDim PSCo As DoubleDim NoCk As DoubleDim CoCk As DoubleDim TempArray() As VariantDim TheRange As RangeDim Size As IntegerDim TempArrayDao() As VariantDim lastrowTK As IntegerDim TaiKhoan() As VariantDim FromDate As DateDim ToDate As Date'--------------------Do Toc Do--------------------------------------Dim Starttime As DoubleDim Code1 As DoubleDim Code2 As DoubleDim Code3 As DoubleDim Code4 As DoubleDim Code5 As DoubleDim Code6 As DoubleDim Code7 As DoubleStarttime = Timer'--------------- Xong Tao Bien --------------------------------------NoDk = 0CoDk = 0PSNo = 0PSCo = 0NoCk = 0CoCk = 0lastrow = Sheet8.Cells(Rows.Count, I).End(xlUp).Row'Them so du dau ky----------------------------------------------------lastrowTK = Sheet7.Cells(Rows.Count, A).End(xlUp).RowTaiKhoan = 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 = Tn ti kho & ChrW(7843) & n :  & TaiKhoan(i, 2)        Exit For    End IfNextCode1 = Round(Timer - Starttime, 2)'----------------------------------------------------------------------Dim NoCongDon As DoubleDim CoCongDon As DoubleSheet26.Select' Dua Du lieu vao Array DulieuDulieu = Sheet8.Range(G2:N & lastrow).ValueFromDate = Sheet26.Cells(6, 3).ValueToDate = Sheet26.Cells(7, 3).ValueSize = 1ReDim TempArray(1 To 6, 1 To Size)Dim tk As Stringtk = Sheet26.Cells(4, 4).TextFor 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) < FromDate Then            NoCongDon = NoCongDon + Dulieu(i, 8)            ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then            TempArray(1, Size) = Dulieu(i, 1)            TempArray(2, Size) = Dulieu(i, 3)            TempArray(3, Size) = Dulieu(i, 5)            TempArray(4, Size) = Dulieu(i, 7)            TempArray(5, Size) = Dulieu(i, 8)            Size = Size + 1            ReDim Preserve TempArray(1 To 6, 1 To Size)            End If        Else            If Dulieu(i, 3) < FromDate Then            CoCongDon = CoCongDon + Dulieu(i, 8)            ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then            TempArray(1, Size) = Dulieu(i, 1)            TempArray(2, Size) = Dulieu(i, 3)            TempArray(3, Size) = Dulieu(i, 5)            TempArray(4, Size) = Dulieu(i, 6)            TempArray(6, Size) = Dulieu(i, 8)            Size = Size + 1            ReDim Preserve TempArray(1 To 6, 1 To Size)            End If        End If    End IfNext iCode2 = Round(Timer - Starttime, 2)'Dao lai Array TamReDim TempArrayDao(1 To Size, 1 To 6)For i = 1 To Size    For j = 1 To 6        TempArrayDao(i, j) = TempArray(j, i)    NextNextk = UBound(TempArrayDao) + 14'Add value to my sheetSet TheRange = Sheet26.Range(A15:F & k)TheRange.Value = TempArrayDaoFormat my sheet, is take me 33s to format my sheet, i don't know why  ..With Sheet26    With .Range(A14:F & k + 1)        .ClearFormats        .Borders.LineStyle = xlContinuous     End WithCode4 = Round(Timer - Starttime, 2) ' code4 is 0.4 s    With .Range(C14:C & k)        .WrapText = True        .Rows.AutoFit        .VerticalAlignment = xlCenter    End WithCode5 = Round(Timer - Starttime, 2) 'code5 is 13,14s    .Range(A14:B & k).HorizontalAlignment = xlCenter    .Range(A14:B & k).VerticalAlignment = xlCenter    With .Range(D14:D & k)        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter        .NumberFormat = @    End With    With .Range(E14:F & k + 1)        .NumberFormat = _(* #,##0_);_(* (#,##0);_(* -??_);_(@_)        .VerticalAlignment = xlCenter    End With    .Range(C & k & :C & k + 1).HorizontalAlignment = xlCenter    .Range(B14:B & k).NumberFormat = dd/mm/yyyyCode6 = Round(Timer - Starttime, 2) ' code6 is 33,97 sEnd WithWith Sheet26.Range(A & k & :F & k + 1)    .Interior.ThemeColor = xlThemeColorDark2    .Font.Bold = TrueEnd WithReDim Dulieu(0, 0) As VariantReDim TempArray(0, 0) As VariantSet TheRange = NothingReDim TempArrayDao(0, 0) As VariantReDim TaiKhoan(0, 0) As VariantApplication.Interactive = TrueApplication.EnableEvents = TrueApplication.ScreenUpdating = True
VBA script to format an Excel sheet
performance;vba;excel
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 CI and then copying the formats to all other rows and picked up about 0.2sWith 111 in D4 of S CI 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 possibleUse 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 thisApplication.EnableEvents = FalseApplication.ScreenUpdating = False'--------------- Tao Bien ------------------------------------------Dim Dulieu() As VariantDim lastrow As IntegerDim lastrowSC As IntegerDim i As IntegerDim j As IntegerDim NoDk As DoubleDim CoDk As DoubleDim PSNo As DoubleDim PSCo As DoubleDim NoCk As DoubleDim CoCk As DoubleDim TempArray() As VariantDim TheRange As RangeDim Size As IntegerDim TempArrayDao() As VariantDim lastrowTK As IntegerDim TaiKhoan() As VariantDim FromDate As DateDim ToDate As Date'--------------------Do Toc Do--------------------------------------Dim Starttime As DoubleDim Code1 As DoubleDim Code2 As DoubleDim Code3 As DoubleDim Code4 As DoubleDim Code5 As DoubleDim Code6 As DoubleDim Code7 As DoubleStarttime = Timer'--------------- Xong Tao Bien --------------------------------------NoDk = 0CoDk = 0PSNo = 0PSCo = 0NoCk = 0CoCk = 0lastrow = Sheet8.Cells(Rows.Count, I).End(xlUp).Row'Them so du dau ky----------------------------------------------------lastrowTK = Sheet7.Cells(Rows.Count, A).End(xlUp).RowTaiKhoan = 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 = Tn ti kho _            & ChrW(7843) & n :  & TaiKhoan(i, 2)        Exit For    End IfNextCode1 = Round(Timer - Starttime, 2)'----------------------------------------------------------------------Dim NoCongDon As DoubleDim CoCongDon As Double' Dua Du lieu vao Array DulieuDulieu = Sheet8.Range(G2:N & lastrow).ValueWith 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) < FromDate Then                    NoCongDon = NoCongDon + Dulieu(i, 8)                ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then                    TempArray(1, Size) = Dulieu(i, 1)                    TempArray(2, Size) = Dulieu(i, 3)                    TempArray(3, Size) = Dulieu(i, 5)                    TempArray(4, Size) = Dulieu(i, 7)                    TempArray(5, Size) = Dulieu(i, 8)                    Size = Size + 1                    ReDim Preserve TempArray(1 To 6, 1 To Size)                End If            Else                If Dulieu(i, 3) < FromDate Then                    CoCongDon = CoCongDon + Dulieu(i, 8)                ElseIf Dulieu(i, 3) = FromDate Or Dulieu(i, 3) <= ToDate Then                    TempArray(1, Size) = Dulieu(i, 1)                    TempArray(2, Size) = Dulieu(i, 3)                    TempArray(3, Size) = Dulieu(i, 5)                    TempArray(4, Size) = Dulieu(i, 6)                    TempArray(6, Size) = Dulieu(i, 8)                    Size = Size + 1                    ReDim Preserve TempArray(1 To 6, 1 To Size)                End If            End If        End If    Next i    Code2 = Round(Timer - Starttime, 2)    'Dao lai Array Tam    ReDim TempArrayDao(1 To Size, 1 To 6)    For i = 1 To Size        For j = 1 To 6            TempArrayDao(i, j) = TempArray(j, i)        Next    Next    '--------------Chep Footer --------------------    lastrowSC = .Cells(Rows.Count, A).End(xlUp).Row    Sheet26.Range(.Cells(lastrowSC - 7, 1), .Cells(lastrowSC, 6)).Cut _    Sheet26.Range(.Cells(UBound(TempArrayDao) + 16, 1), .Cells(UBound(TempArrayDao) + 16 + 7, 13))    .Range(.Cells(14, 1), .Cells(UBound(TempArrayDao) + 16, 6)).Clear    If (UBound(TempArrayDao) + 16 + 8 < lastrowSC) Then        .Range(.Cells(UBound(TempArrayDao) + 16 + 8, 1), .Cells(lastrowSC, 6)).Clear    End If    Code3 = Round(Timer - Starttime, 2)    '--------------Xong Chep Footer ---------------    k = UBound(TempArrayDao) + 14    'Them du lieu vao So cai    Set TheRange = .Range(A15:F & k)    TheRange.Value = TempArrayDao    '--------------- Giai phong Bien ------------------------------------------    ReDim Dulieu(0, 0) As Variant    ReDim TempArray(0, 0) As Variant    Set TheRange = Nothing    ReDim TempArrayDao(0, 0) As Variant    ReDim TaiKhoan(0, 0) As Variant'--------------- Xong Tao Bien --------------------------------------'Format lai bang Cong No    With .Range(A14:F14)        .ClearFormats        .Borders.LineStyle = xlContinuous        .VerticalAlignment = xlCenter    End With    With .Range(A14:D14)       .HorizontalAlignment = xlCenter    End With    With .Range(E14:F14)       .NumberFormat = _(* #,##0_);_(* (#,##0);_(* -??_);_(@_)    End With    .Range(B14:B14).NumberFormat = dd/mm/yyyy    .Range(C14:C14).WrapText = True    .Range(D14:D14).NumberFormat = @    .Range(A14:F14).Copy    .Range(A14:F & k).PasteSpecial xlPasteFormats    With .Range(A & k & :F & k + 1)        .Interior.ThemeColor = xlThemeColorDark2        .Font.Bold = True    End With    .Range(C & k).Value = T & ChrW(7893) & ng pht sinh    .Range(C & k + 1).Value = Cu & ChrW(7889) & i k & ChrW(7923)    .Cells(14, 3).Value = S d & ChrW(432) &   & ChrW(273) & ChrW(7847) & u k & ChrW(7923)    .Cells(8, 5).Value = NoDk    .Cells(8, 6).Value = CoDk    .Cells(14, 5).Value = NoDk    .Cells(14, 6).Value = CoDk    If NoDk > 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).SelectEnd WithCode7 = Round(Timer - Starttime, 2)Application.Interactive = TrueApplication.EnableEvents = TrueApplication.ScreenUpdating = TrueEnd Sub