Insert rows and values

[powder]

Hi Forum -- I'm looking for advise to assign values in column B to the unique values in column A. The results will look like column C. Thanks!

------
A | B
------
A |
B |
C | 1
C | 2
C | 3

---
C
---
A1
A2
A3
B1
B2
B3
C1
C2
C3

 

[nikio8]

you can try this,

Sub GetUniqueCouples()
    Dim i, j, k, lastA, lastB As Long
    Dim MyArray() As String
    
   lastA = Cells(Rows.Count, 1).End(xlUp).Row
   lastB = Cells(Rows.Count, 2).End(xlUp).Row
    
    ReDim MyArray(lastA * lastB)
    
    MyArray(0) = "Result"
    
    k = 1
    For i = 2 To lastA
        For j = 2 To lastB
            MyArray(k) = Cells(i, "A").Value & Cells(j, "B").Value
            k = k + 1
        Next j
    Next i
    
    Range("D1:D" & UBound(MyArray) + 1) = WorksheetFunction.Transpose(MyArray)
  
    Cells(1, "E").Value = Cells(1, "D").Value
    Range("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1"), Unique:=True

   'Range("D:D").ClearContents
    
End Sub

 

[powder]

This is awesome! Thank you very much.

What if I have another column of values like so:

-----------
A | B | C
-----------
A | |
B | |
C | 1 | Cat
C | 2 | Dog
C | 3 | Rat

---------
Results
---------
A1Cat
A2Dog
A3Rat
B1Cat
B2Dog
B3Rat
C1Cat
C2Dog
C3Rat

I'm trying to learn VBA and appreciate your advise.

 

[nikio8]

things get a bit tricky, i am learning too, that is why I am here

PS try not to have empty fields on top. this may cause issues.
A 1 dog
A 1 cat
A 1
B
B

Sub GetUniqueCouples()
    Dim i, j, k,[COLOR=#ff0000] l,[/COLOR] lastA, lastB[COLOR=#ff0000], lastC[/COLOR] As Long
    Dim MyArray() As String
    
   lastA = Cells(Rows.Count, 1).End(xlUp).Row
   lastB = Cells(Rows.Count, 2).End(xlUp).Row
   [COLOR=#ff0000]lastC = Cells(Rows.Count, 3).End(xlUp).Row[/COLOR]
    
    ReDim MyArray(lastA * lastB [COLOR=#ff0000]* lastC)[/COLOR]
    
    MyArray(0) = "Result"
    
    k = 1
    For i = 2 To lastA
        For j = 2 To lastB
           [COLOR=#ff0000]For l = 2 to lastC[/COLOR]
            MyArray(k) = Cells(i, "A").Value & Cells(j, "B").Value[COLOR=#ff0000] & Cells(l, "C").Value[/COLOR]
            k = k + 1
          [COLOR=#ff0000]Next l[/COLOR]
        Next j
    Next i
    
    Range("D1:D" & UBound(MyArray) + 1) = WorksheetFunction.Transpose(MyArray)
  
    Cells(1, "E").Value = Cells(1, "D").Value
    Range("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1"), Unique:=True

   'Range("D:D").ClearContents
    
End Sub

 

[powder]

Sorry for the belated response... The solution works well! Thank you.