Take records from two separate lists and getting one output

user_18272226 0
Viewed 34

I'm new to VBA and I am stuck on how to duplicate records from one list based on records from a second list. Basically, I have list A which has a list of customer IDs and I have list B which contains promo codes. I need to create a file that has a column of every promo code in list B duplicated for each customer ID from list A. I think I need to use a double loop statement, but I'm not very good at writing loops.

This is an example of what I'm trying to accomplish

enter image description here

vba excel
2 Answers

Rebecca: happy to help a new contributor.

If your customer list is in cells A2:15 and your promo codes are in cells C2:C5, this will create the new list in column e.

Sub Merge_Table()
    Worksheets("Test1").Activate
    Range("E1").Select
    For Each customer In Range("A2:A5").Cells
       For Each promo In Range("C2:C5").Cells
          ActiveCell.Value = customer
          ActiveCell.Offset(0, 1).Value = promo
          ActiveCell.Offset(1, 0).Activate
       Next promo
   Next customer
End Sub
user_6189300

Permutations

  • Copy the code into a standard module, e.g. Module1.
  • Adjust the values (the worksheet (tab) name, all the columns, and rows).
Option Explicit

Sub PermutateBeginner()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    
    Dim fr1 As Long: fr1 = 4
    Dim lr1 As Long: lr1 = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim fr2 As Long: fr2 = 4
    Dim lr2 As Long: lr2 = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    Dim fr3 As Long: fr3 = 4
    Dim r3 As Long: r3 = fr3
    
    Dim r1 As Long
    Dim r2 As Long
    
    For r1 = fr1 To lr1
        For r2 = fr2 To lr2
            ws.Cells(r3, "G").Value = ws.Cells(r1, "A").Value
            ws.Cells(r3, "H").Value = ws.Cells(r2, "C").Value
            r3 = r3 + 1
        Next r2
    Next r1
    
    MsgBox "Permutations created.", vbInformation
    
End Sub
user_98140690
Related