Skip to main content
deleted 48 characters in body; edited title
Source Link
Jamal
  • 35.2k
  • 13
  • 134
  • 238

While trying to generate Generating output comment for 70000 rows on the basis of multiple if conditions, this excel-vba code is taking a lot of time

For traversing 70,000 rows  (using fora for loop), my macro is taking a lot of time to give output comment as per various conditions  (ifif statement). Please help me improve my approach.I I am working on around 70,000 rows and my code is taking a lot of time to run. Please see the attachment image that depicts how data looks. Can someone please guide me with a better approach here?

While trying to generate output comment for 70000 rows on the basis of multiple if conditions, this excel-vba code is taking a lot of time

For traversing 70,000 rows(using for loop), my macro is taking a lot of time to give output comment as per various conditions(if statement). Please help me improve my approach.I am working on around 70,000 rows and my code is taking a lot of time to run. Please see the attachment image that depicts how data looks. Can someone please guide me with a better approach here?

Generating output comment for 70000 rows

For traversing 70,000 rows  (using a for loop), my macro is taking a lot of time to give output comment as per various conditions  (if statement). Please help me improve my approach. I am working on around 70,000 rows and my code is taking a lot of time to run. Please see the attachment image that depicts how data looks.

Post Reopened by yuri, alecxe, rolfl
Declared all the variables.
Source Link

Reducing run time While trying to generate output comment for 70000 rows on the basis of multiple if conditions, this excel-vba macro snippetcode is taking a lot of time

enter image description here

Option Explicit
Sub Analysis()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim wsa As Worksheet
Dim l, AudLastRow, AudLastCol, NIMsLastCol, NIMsRow As Long
Dim d19, d8, d25, p19, p8, p25 As Integer
Dim ColLtr As String
Dim aPRTS, bNIMS, Deployed19, Deployed800, Deployed2500, PRTS800, PRTS1900, PRTS2500 As Variant

Set wsa = ThisWorkbook.SheetsWorksheets("Audit-NIMS vs Site Topology")
NIMsLastCol = ThisWorkbook.Sheets("NIMSCarrierCount").Cells(2, Columns.Count).End(xlToLeft).Column
NIMsRow = ThisWorkbook.Sheets("NIMS dump-SC level").Cells(Rows.Count, 2).End(xlUp).Row

With wsa
    AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    AudLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"
 
    For l = 2 To AudLastRow
        aPRTS = .Cells(l, AudLastCol).Value
        bNIMS = .Cells(l, NIMsLastCol).Value
'        tempin = .Cells(l, 2).Value
 
        If aPRTS = bNIMS Then
            Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
            If IsNumeric(Deployed19) Then
                d19 = .Cells(l, Deployed19).Value
            Else
                d19 = 0
            End If
            Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
            If IsNumeric(Deployed800) Then
                d8 = .Cells(l, Deployed800).Value
            Else
                d8 = 0
            End If
            Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
            If IsNumeric(Deployed2500) Then
                d25 = .Cells(l, Deployed2500).Value
            Else
                d25 = 0
            End If
            
            PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS800) Then
                p8 = .Cells(l, PRTS800).Value
            Else
                p8 = 0
            End If
            
            PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS1900) Then
                p19 = .Cells(l, PRTS1900).Value
            Else
                p19 = 0
            End If
            
            PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS2500) Then
                p25 = .Cells(l, PRTS2500).Value
            Else
                p25 = 0
            End If
            If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
                .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
            Else
                .Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
            End If
        ElseIf aPRTS = "NA" And bNIMS = "0" Then
            .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
        ElseIf aPRTS = "0" And bNIMS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
        ElseIf aPRTS > 0 And bNIMS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
        ElseIf bNIMS > 0 And aPRTS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "N/A;PRTS;Check traffic from PRTS & Report to PRTS Team."
        ElseIf bNIMS > aPRTS Then
            .Cells(l, AudLastCol + 1).Value = "FALSE;PRTS;Check traffic from PRTS & Report to PRTS Team."
        ElseIf bNIMS < aPRTS Then
            .Cells(l, AudLastCol + 1).Value = "FALSE;NIMS;Update NIMS."
        End If
'To compare certain category of Name and concatenate output accordingly.
        If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
        ElseIf InStr(1, .Cells(l, 1).Value, "82XC") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
        ElseIf InStr(1, .Cells(l, 1).Value, "XT") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "COW Site."
        End If
    
        If bNIMS = "NA" And Application.CountIf(ThisWorkbook.Sheets("NIMS dump-SC level").Range("B1:B" & temprowNIMsRow), .Cells(l, 2).Value) Then
            .Cells(l, AudLastCol + 1).Value = Cells(l, AudLastCol + 1).Value & "Present in NIMS Dump."
        End If
    Next l
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.DisplayAlerts = True    
End Sub

Reducing run time of excel-vba macro snippet

Set wsa = ThisWorkbook.Sheets("Audit-NIMS vs Site Topology")

With wsa
AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"
 
For l = 2 To AudLastRow
aPRTS = .Cells(l, AudLastCol).Value
bNIMS = .Cells(l, NIMsLastCol).Value
tempin = .Cells(l, 2).Value
 
If aPRTS = bNIMS Then
    Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
    If IsNumeric(Deployed19) Then
        d19 = .Cells(l, Deployed19).Value
    Else
        d19 = 0
    End If
    Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
    If IsNumeric(Deployed800) Then
        d8 = .Cells(l, Deployed800).Value
    Else
        d8 = 0
    End If
    Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
    If IsNumeric(Deployed2500) Then
        d25 = .Cells(l, Deployed2500).Value
    Else
        d25 = 0
    End If

    PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS800) Then
        p8 = .Cells(l, PRTS800).Value
    Else
        p8 = 0
    End If

    PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS1900) Then
        p19 = .Cells(l, PRTS1900).Value
    Else
        p19 = 0
    End If

    PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS2500) Then
        p25 = .Cells(l, PRTS2500).Value
    Else
        p25 = 0
    End If
    If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
        .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
    Else
        .Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
    End If
ElseIf aPRTS = "NA" And bNIMS = "0" Then
    .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS = "0" And bNIMS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS > 0 And bNIMS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
ElseIf bNIMS > 0 And aPRTS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "N/A;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS > aPRTS Then
    .Cells(l, AudLastCol + 1).Value = "FALSE;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS < aPRTS Then
    .Cells(l, AudLastCol + 1).Value = "FALSE;NIMS;Update NIMS."
End If
'To compare certain category of Name and concatenate output accordingly.
If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "82XC") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "XT") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "COW Site."
End If

If bNIMS = "NA" And Application.CountIf(ThisWorkbook.Sheets("NIMS dump-SC level").Range("B1:B" & temprow), .Cells(l, 2).Value) Then
    .Cells(l, AudLastCol + 1).Value = Cells(l, AudLastCol + 1).Value & "Present in NIMS Dump."
End If
Next l
End With

While trying to generate output comment for 70000 rows on the basis of multiple if conditions, this excel-vba code is taking a lot of time

enter image description here

Option Explicit
Sub Analysis()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim wsa As Worksheet
Dim l, AudLastRow, AudLastCol, NIMsLastCol, NIMsRow As Long
Dim d19, d8, d25, p19, p8, p25 As Integer
Dim ColLtr As String
Dim aPRTS, bNIMS, Deployed19, Deployed800, Deployed2500, PRTS800, PRTS1900, PRTS2500 As Variant

Set wsa = ThisWorkbook.Worksheets("Audit-NIMS vs Site Topology")
NIMsLastCol = ThisWorkbook.Sheets("NIMSCarrierCount").Cells(2, Columns.Count).End(xlToLeft).Column
NIMsRow = ThisWorkbook.Sheets("NIMS dump-SC level").Cells(Rows.Count, 2).End(xlUp).Row

With wsa
    AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    AudLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"
    For l = 2 To AudLastRow
        aPRTS = .Cells(l, AudLastCol).Value
        bNIMS = .Cells(l, NIMsLastCol).Value
'        tempin = .Cells(l, 2).Value
        If aPRTS = bNIMS Then
            Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
            If IsNumeric(Deployed19) Then
                d19 = .Cells(l, Deployed19).Value
            Else
                d19 = 0
            End If
            Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
            If IsNumeric(Deployed800) Then
                d8 = .Cells(l, Deployed800).Value
            Else
                d8 = 0
            End If
            Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
            If IsNumeric(Deployed2500) Then
                d25 = .Cells(l, Deployed2500).Value
            Else
                d25 = 0
            End If
            
            PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS800) Then
                p8 = .Cells(l, PRTS800).Value
            Else
                p8 = 0
            End If
            
            PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS1900) Then
                p19 = .Cells(l, PRTS1900).Value
            Else
                p19 = 0
            End If
            
            PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
            If IsNumeric(PRTS2500) Then
                p25 = .Cells(l, PRTS2500).Value
            Else
                p25 = 0
            End If
            If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
                .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
            Else
                .Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
            End If
        ElseIf aPRTS = "NA" And bNIMS = "0" Then
            .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
        ElseIf aPRTS = "0" And bNIMS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
        ElseIf aPRTS > 0 And bNIMS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
        ElseIf bNIMS > 0 And aPRTS = "NA" Then
            .Cells(l, AudLastCol + 1).Value = "N/A;PRTS;Check traffic from PRTS & Report to PRTS Team."
        ElseIf bNIMS > aPRTS Then
            .Cells(l, AudLastCol + 1).Value = "FALSE;PRTS;Check traffic from PRTS & Report to PRTS Team."
        ElseIf bNIMS < aPRTS Then
            .Cells(l, AudLastCol + 1).Value = "FALSE;NIMS;Update NIMS."
        End If
        
        If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
        ElseIf InStr(1, .Cells(l, 1).Value, "82XC") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
        ElseIf InStr(1, .Cells(l, 1).Value, "XT") > 0 Then
            .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "COW Site."
        End If
    
        If bNIMS = "NA" And Application.CountIf(ThisWorkbook.Sheets("NIMS dump-SC level").Range("B1:B" & NIMsRow), .Cells(l, 2).Value) Then
            .Cells(l, AudLastCol + 1).Value = Cells(l, AudLastCol + 1).Value & "Present in NIMS Dump."
        End If
    Next l
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.DisplayAlerts = True    
End Sub
Post Closed as "Not suitable for this site" by πάντα ῥεῖ, Stephen Rauch, Dan Oberlam, hoffmale, Sᴀᴍ Onᴇᴌᴀ
Source Link

Reducing run time of excel-vba macro snippet

For traversing 70,000 rows(using for loop), my macro is taking a lot of time to give output comment as per various conditions(if statement). Please help me improve my approach.I am working on around 70,000 rows and my code is taking a lot of time to run. Please see the attachment image that depicts how data looks. Can someone please guide me with a better approach here?

Set wsa = ThisWorkbook.Sheets("Audit-NIMS vs Site Topology")

With wsa
AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"

For l = 2 To AudLastRow
aPRTS = .Cells(l, AudLastCol).Value
bNIMS = .Cells(l, NIMsLastCol).Value
tempin = .Cells(l, 2).Value

If aPRTS = bNIMS Then
    Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
    If IsNumeric(Deployed19) Then
        d19 = .Cells(l, Deployed19).Value
    Else
        d19 = 0
    End If
    Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
    If IsNumeric(Deployed800) Then
        d8 = .Cells(l, Deployed800).Value
    Else
        d8 = 0
    End If
    Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
    If IsNumeric(Deployed2500) Then
        d25 = .Cells(l, Deployed2500).Value
    Else
        d25 = 0
    End If

    PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS800) Then
        p8 = .Cells(l, PRTS800).Value
    Else
        p8 = 0
    End If

    PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS1900) Then
        p19 = .Cells(l, PRTS1900).Value
    Else
        p19 = 0
    End If

    PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
    If IsNumeric(PRTS2500) Then
        p25 = .Cells(l, PRTS2500).Value
    Else
        p25 = 0
    End If
    If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
        .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
    Else
        .Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
    End If
ElseIf aPRTS = "NA" And bNIMS = "0" Then
    .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS = "0" And bNIMS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS > 0 And bNIMS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
ElseIf bNIMS > 0 And aPRTS = "NA" Then
    .Cells(l, AudLastCol + 1).Value = "N/A;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS > aPRTS Then
    .Cells(l, AudLastCol + 1).Value = "FALSE;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS < aPRTS Then
    .Cells(l, AudLastCol + 1).Value = "FALSE;NIMS;Update NIMS."
End If
'To compare certain category of Name and concatenate output accordingly.
If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "82XC") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "XT") > 0 Then
    .Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "COW Site."
End If

If bNIMS = "NA" And Application.CountIf(ThisWorkbook.Sheets("NIMS dump-SC level").Range("B1:B" & temprow), .Cells(l, 2).Value) Then
    .Cells(l, AudLastCol + 1).Value = Cells(l, AudLastCol + 1).Value & "Present in NIMS Dump."
End If
Next l
End With