Skip to main content
1 of 4

Code iterates through all rows and inserts value in cell for each

I would like that this code would now be done in a faster way:

Sub TechMapping()
    
    Set mappingWB = Workbooks.Open(Filename:="path\workbook1.xlsx")
    Sheets("Sheet1").Activate
    Dim Lookup_Range As Range
    Set Lookup_Range = Range("A2:P1779")
    
    Workbooks("workbook2.xlsb").Activate
    Set sh = ActiveSheet
    
    Dim i As Long   
    i = 2
    Do While i <= LastRow
    
        Set appid = sh.Range("A" & i)
        Set appnonapp = sh.Range("B" & i)
        Set customercountry = sh.Range("G" & i)
        Set lastactuals = sh.Range("P" & i)
        Set lasttotal = sh.Range("O" & i)
    
        If appnonapp.Value = "condition1" And customercountry.Value = "country1" Then
    
            Dim DStest As Variant
            DStest = Application.VLookup(appid, Lookup_Range, 7, False)
    
            If IsError(DStest) Then
    
                i = i + 1
                GoTo Line1
    
            Else
    
                Dim totalDS As Integer
                totalDS = Application.WorksheetFunction.VLookup(appid, Lookup_Range, 6, False)
    
                Dim columnnr As Integer
                columnnr = 7
    
                If totalDS = 1 Then
    
                    appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)
    
                Else
    
                    appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)
                    appid.Offset(columnoffset:=15) = lastactuals / totalDS
                    appid.Offset(columnoffset:=14) = lasttotal / totalDS
    
                    For j = 1 To totalDS - 1
    
                        Dim newcolumn As Integer
                        newcolumn = 7 + 2 * j 
    
                        sh.Rows(i).Copy
                        sh.Rows(i).Offset(j).Insert Shift:=xlDown
                        appid.Offset(j, 16) = Application.VLookup(appid, Lookup_Range, newcolumn, False)
                        LastRow = LastRow + 1
    
                    Next j
    
                    Application.CutCopyMode = False
    
                End If
    
            End If
    
    ElseIf appnonapp.Value = "condition1" And customercountry.Value <> "country1" Then ' Step 9
    
            appid.Offset(columnoffset:=16) = "option 1"
    
        ElseIf appnonapp.Value = "condition2" And customercountry.Value <> "country1" Then ' Step 10
    
            appid.Offset(columnoffset:=16) = "option 2"
    
        ElseIf appnonapp.Value <> "condition2" And appnonapp.Value <> "condition1" And customercountry.Value <> "country1" Then ' Step 11
    
            appid.Offset(columnoffset:=16) = "option 3"
    
        Else
    
        End If
    
        i = i + totalDS
    
    Line1:
    Loop

From what i have realized, i believe it's possible to store all values i want to insert in a temporary variable and then insert them all at once instead of doing the insert at every single row iteration. This would considerably reduce the execution time for this code.

How can this be done?

Thanks!