Loop through list and append results VBA

user_6376763 0
Viewed 176

I have a main sheet, its a dashboard style sheet pulling in information from linked sheets(its used to spot check). All the results for the sheet is driven by one cell(an ID), I have a list of IDs that I want to flow through the cell and then copy the one line of results and append it to some other sheet. I recorded the function to try to explain what im doing.

Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[1]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

I then did it multiple times to show how the whole process would look:

Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[2]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[3]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Data Input").Select
Range("L3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=List!R[4]C[-11]"
Rows("32:32").Select
Selection.Copy
Sheets("results").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

So overall theres three sheets. Data input where the results and functions live, List where contains a list of IDs and Results where I just need to append the one row from Data Input(row32)

vba excel
1 Answers

You can do something like this:

    Dim wsList As Worksheet, wsData As Worksheet, wsResult As Worksheet
    Dim c As Range, rwDest As Range
    
    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsData = ThisWorkbook.Worksheets("Data Input")
    Set wsResult = ThisWorkbook.Worksheets("Result")

    Set rwDest = wsResult.Rows(3)                'first destination row
    
    For Each c In wsList.Range("A2:A100").Cells  'for example
        If c.Value <> "" Then
            wsData.Range("L3").Value = c.Value
            wsData.Calculate
            rwDest.Value = wsData.Rows(32).Value 'copy row values
            Set rwDest = rwDest.Offset(1, 0)     'next destination row
        End If
    Next c
user_4788840
Related