Improve code performance to Optimize Loops

**MusicMan** · 04-19-2021, 10:19 AM

Hi,

Is there a more efficient way to optimize the code below to improve its performance because on a large data set with over 20,00o records it is very slow?
Thanks in advance for any assistance that you can provide.


Sub Update_New_Data_Completes()
    Dim Firstrow As Long
    Dim LastRow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
   
    With ActiveSheet
        .Select
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False
        
        Firstrow = 2
        LastRow = .Cells(.Rows.count, "A").End(xlUp).Row
        
        For Lrow = LastRow To Firstrow Step -1
        
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 9).Value <> "" And .Offset(0, 10).Value = "" Then
                                .Offset(0, 10).Value = "N/A"
                                .Offset(0, 11).Value = "N/A"
                                .Offset(0, 12).Value = "N/A"
                                .Offset(0, 13).Value = "N/A"
                                .Offset(0, 14).Value = "N/A"
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 9).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 10).Value <> "" And .Offset(0, 11).Value = "" Then
                                .Offset(0, 11).Value = "N/A"
                                .Offset(0, 12).Value = "N/A"
                                .Offset(0, 13).Value = "N/A"
                                .Offset(0, 14).Value = "N/A"
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 9).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 11).Value <> "" And .Offset(0, 12).Value = "" Then
                                .Offset(0, 12).Value = "N/A"
                                .Offset(0, 13).Value = "N/A"
                                .Offset(0, 14).Value = "N/A"
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 9).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 12).Value <> "" And .Offset(0, 13).Value = "" Then
                                .Offset(0, 13).Value = "N/A"
                                .Offset(0, 14).Value = "N/A"
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 12).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 13).Value <> "" And .Offset(0, 14).Value = "" Then
                                .Offset(0, 14).Value = "N/A"
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 12).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 14).Value <> "" And .Offset(0, 15).Value = "" Then
                                .Offset(0, 15).Value = "N/A"
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 12).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 15).Value <> "" And .Offset(0, 16).Value = "" Then
                                .Offset(0, 16).Value = "N/A"
                                .Offset(0, 17).Value = .Offset(, 12).Value
                            End If
                    End If
                End If
            End With
            With .Cells(Lrow, "A")
                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then
                            If .Offset(0, 16).Value <> "" And .Offset(0, 17).Value = "" Then
                                .Offset(0, 17).Value = .Offset(, 12).Value
                            End If
                    End If
                End If
            End With
        Next Lrow
    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

i

**romperstomper** · 04-19-2021, 10:31 AM

It would be helpful to see a sample workbook (see yellow banner at the top of the page) but I don't understand why you seem to be testing the same conditions repeatedly , namely:

                If Not IsError(.Value) Then
                    If .Offset(0, 18).Value Like "*COPIER*" Or .Offset(0, 18).Value _
                        Like "*REMOVE*" Or .Offset(0, 19).Value = "YES" Then

**romperstomper** · 04-19-2021, 10:41 AM

Untested, but this might do what you want:

Sub Update_New_Data_Completes()
    Dim Firstrow As Long
    Dim LastRow As Long
    Dim Lrow As Long

    Application.ScreenUpdating = False
   
    With ActiveSheet
        Firstrow = 2
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim dataset
        dataset = .Range(.Cells(Firstrow, "A"), .Cells(LastRow, "T")).Value
        For Lrow = LBound(dataset) To UBound(dataset)
            If Not IsError(dataset(Lrow, 1)) Then
                If dataset(Lrow, 19) Like "*COPIER*" Or dataset(Lrow, 19) _
                    Like "*REMOVE*" Or dataset(Lrow, 20) = "YES" Then
                        If dataset(Lrow, 10) <> "" And dataset(Lrow, 11) = "" Then
                            dataset(Lrow, 11) = "N/A"
                            dataset(Lrow, 12) = "N/A"
                            dataset(Lrow, 13) = "N/A"
                            dataset(Lrow, 14) = "N/A"
                            dataset(Lrow, 15) = "N/A"
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 10)
                        ElseIf dataset(Lrow, 11) <> "" And dataset(Lrow, 12) = "" Then
                            dataset(Lrow, 12) = "N/A"
                            dataset(Lrow, 13) = "N/A"
                            dataset(Lrow, 14) = "N/A"
                            dataset(Lrow, 15) = "N/A"
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 10)
                        ElseIf dataset(Lrow, 12) <> "" And dataset(Lrow, 13) = "" Then
                            dataset(Lrow, 13) = "N/A"
                            dataset(Lrow, 14) = "N/A"
                            dataset(Lrow, 15) = "N/A"
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 10)
                        ElseIf dataset(Lrow, 13) <> "" And dataset(Lrow, 14) = "" Then
                            dataset(Lrow, 14) = "N/A"
                            dataset(Lrow, 15) = "N/A"
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 10)
                        ElseIf dataset(Lrow, 14) <> "" And dataset(Lrow, 15) = "" Then
                            dataset(Lrow, 15) = "N/A"
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 13)
                        ElseIf dataset(Lrow, 15) <> "" And dataset(Lrow, 16) = "" Then
                            dataset(Lrow, 16) = "N/A"
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 13)
                        ElseIf dataset(Lrow, 16) <> "" And dataset(Lrow, 17) = "" Then
                            dataset(Lrow, 17) = "N/A"
                            dataset(Lrow, 18) = dataset(Lrow, 13)
                        ElseIf dataset(Lrow, 17) <> "" And dataset(Lrow, 18) = "" Then
                            dataset(Lrow, 18) = dataset(Lrow, 13)
                        End If
                End If
            End If
        Next Lrow
        .Range(.Cells(Firstrow, "A"), .Cells(LastRow, "T")).Value = dataset
    End With

    Application.ScreenUpdating = True

End Sub

**Richard Buttrey** · 04-19-2021, 01:07 PM

Hi,

Since you're essentially testing three conditions, columns 10 & 11, 11 & 12 and 12 & 13 , and writing N/A to either columns 11:12, 12:18 or just 13, another approach would be to use a helper column and use standard Excel IF...Functions to flag it and identify which of the three is relevant.

Then all you need do is use an Autofilter three times and use the .SpecialCells(xlCellTypeVisible) syntax to update the relevant columns with the N/A.

**MusicMan** · 04-19-2021, 12:44 PM

Thanks a million rorya for your expertise. This works quit well. It cuts my time down to a fraction of my previous time.

**romperstomper** · 04-19-2021, 12:46 PM

Glad we could help.

Improve code performance to Optimize Loops

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Improve code performance to Optimize Loops

Re: Improve code performance to Optimize Loops

Re: Improve code performance to Optimize Loops

Re: Improve code performance to Optimize Loops

Re: Improve code performance to Optimize Loops

Re: Improve code performance to Optimize Loops

Thread Information

Users Browsing this Thread

Similar Threads

Improve performance

Please assit to Optimize the performance

Optimize workbook performance - excel keeps thinking and crashing

How to improve performance of my code?, now is too slow!!

VBA For loop, optimize speed and performance

improve performance

[SOLVED] optimize macro - cutting down loops and autofill

Bookmarks

Bookmarks

Posting Permissions