Excelnewbie001
Board Regular
- Joined
- Jan 25, 2017
- Messages
- 79
Wonder if someone can help me. I have the following code where collections are made on 3 cells H2 I2 J2 -if I want the collections to be on 3 columns instead of 3 cells what code must change.The collections get checked on column A1-15 and B1-15 respectively.So the collections must be on 3 columns values instead of 3 cells column H and I and I.Can this be done ? Any help appreciated -sorry the range will be 3 columns thats done but it should still do the collection -think I got my terminology mixed up there. So the range must be 3 columns instead of 3 cells.Thanks for any help
Code:
Sub Test()
Sheets("Sheet1").Activate
Dim a(), c As New Collection, d As New Collection, i As Long, j As Long, strKey As String, x As String, y As String, z As String, v1, v2, v3
Sheets("Sheet1").Select
a = Range("A1").CurrentRegion.Value
x = Range("H2").Value ' >>>>>> 3 cells H2 I2 J2
y = Range("I2").Value
z = Range("J2").Value
For i = 2 To UBound(a, 1)
strKey = CStr(a(i, 2))
On Error Resume Next
c.Add Key:=strKey, Item:=New Collection
On Error GoTo 0
c(strKey).Add a(i, 1)
Next i
On Error Resume Next
Set v1 = c(x)
Set v1 = c(y)
Set v1 = c(z)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
For Each v1 In c(x)
For Each v2 In c(y)
For Each v3 In c(z)
d.Add Array(v1, v2, v3)
Next v3
Next v2
Next v1
ReDim a(1 To d.Count, 1 To 3)
i = 0
For Each v1 In d
i = i + 1
a(i, 1) = v1(0)
a(i, 2) = v1(1)
a(i, 3) = v1(2)
Next v1
Range("N18").Resize(UBound(a, 1), UBound(a, 2)).Value = a
End Sub
Last edited: