Blank_2_Years (3).xlsx | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
B | C | D | E | F | G | H | I | |||
1 | APPLES | 123 | A0001 | A0001 | APPLES | 123 | ||||
2 | ORANGES | 456 | A0002 | A0001 | ORANGES | 456 | ||||
3 | PEARS | 789 | A0003 | A0001 | PEARS | 789 | ||||
4 | BANANAS | 101112 | A0004 | A0001 | BANANAS | 101112 | ||||
5 | A0005 | A0002 | APPLES | 123 | ||||||
6 | A0006 | A0002 | ORANGES | 456 | ||||||
7 | A0002 | PEARS | 789 | |||||||
8 | A0002 | BANANAS | 101112 | |||||||
9 | A0003 | APPLES | 123 | |||||||
10 | A0003 | ORANGES | 456 | |||||||
11 | A0003 | PEARS | 789 | |||||||
12 | A0003 | BANANAS | 101112 | |||||||
13 | A0004 | APPLES | 123 | |||||||
14 | A0004 | ORANGES | 456 | |||||||
15 | A0004 | PEARS | 789 | |||||||
16 | A0004 | BANANAS | 101112 | |||||||
17 | A0005 | APPLES | 123 | |||||||
18 | A0005 | ORANGES | 456 | |||||||
19 | A0005 | PEARS | 789 | |||||||
20 | A0005 | BANANAS | 101112 | |||||||
21 | A0006 | APPLES | 123 | |||||||
22 | A0006 | ORANGES | 456 | |||||||
23 | A0006 | PEARS | 789 | |||||||
24 | A0006 | BANANAS | 101112 | |||||||
Sheet2 |
Cell Formulas | ||
---|---|---|
Range | Formula | |
E1:E6 | E1 | ="A"&TEXT(SEQUENCE(6),"0000") |
G1:I24 | G1 | =LET(a,B1:B4,c,E1:E6,ra,ROWS(a),rt,ra*ROWS(c),ss,MOD(SEQUENCE(rt)-1,ra)+1,CHOOSE({1,2,3},INDEX(c,INT(SEQUENCE(rt,,,1/ra))),INDEX(a,ss),INDEX(C1:C4,ss))) |
Dynamic array formulas. |
i would rather use vbaCould do it using formulas.
Blank_2_Years (3).xlsx
B C D E F G H I 1 APPLES 123 A0001 A0001 APPLES 123 2 ORANGES 456 A0002 A0001 ORANGES 456 3 PEARS 789 A0003 A0001 PEARS 789 4 BANANAS 101112 A0004 A0001 BANANAS 101112 5 A0005 A0002 APPLES 123 6 A0006 A0002 ORANGES 456 7 A0002 PEARS 789 8 A0002 BANANAS 101112 9 A0003 APPLES 123 10 A0003 ORANGES 456 11 A0003 PEARS 789 12 A0003 BANANAS 101112 13 A0004 APPLES 123 14 A0004 ORANGES 456 15 A0004 PEARS 789 16 A0004 BANANAS 101112 17 A0005 APPLES 123 18 A0005 ORANGES 456 19 A0005 PEARS 789 20 A0005 BANANAS 101112 21 A0006 APPLES 123 22 A0006 ORANGES 456 23 A0006 PEARS 789 24 A0006 BANANAS 101112 Sheet2
Cell Formulas Range Formula E1:E6 E1 ="A"&TEXT(SEQUENCE(6),"0000") G1:I24 G1 =LET(a,B1:B4,c,E1:E6,ra,ROWS(a),rt,ra*ROWS(c),ss,MOD(SEQUENCE(rt)-1,ra)+1,CHOOSE({1,2,3},INDEX(c,INT(SEQUENCE(rt,,,1/ra))),INDEX(a,ss),INDEX(C1:C4,ss))) Dynamic array formulas.
Blank_2_Years (3).xlsx | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
B | C | D | E | F | G | H | I | |||
1 | APPLES | 123 | A0001 | A0001 | APPLES | 123 | ||||
2 | ORANGES | 456 | A0002 | A0001 | ORANGES | 456 | ||||
3 | PEARS | 789 | A0003 | A0001 | PEARS | 789 | ||||
4 | BANANAS | 101112 | A0004 | A0001 | BANANAS | 101112 | ||||
5 | A0005 | A0002 | APPLES | 123 | ||||||
6 | A0006 | A0002 | ORANGES | 456 | ||||||
7 | A0002 | PEARS | 789 | |||||||
8 | A0002 | BANANAS | 101112 | |||||||
9 | A0003 | APPLES | 123 | |||||||
10 | A0003 | ORANGES | 456 | |||||||
11 | A0003 | PEARS | 789 | |||||||
12 | A0003 | BANANAS | 101112 | |||||||
13 | A0004 | APPLES | 123 | |||||||
14 | A0004 | ORANGES | 456 | |||||||
15 | A0004 | PEARS | 789 | |||||||
16 | A0004 | BANANAS | 101112 | |||||||
17 | A0005 | APPLES | 123 | |||||||
18 | A0005 | ORANGES | 456 | |||||||
19 | A0005 | PEARS | 789 | |||||||
20 | A0005 | BANANAS | 101112 | |||||||
21 | A0006 | APPLES | 123 | |||||||
22 | A0006 | ORANGES | 456 | |||||||
23 | A0006 | PEARS | 789 | |||||||
24 | A0006 | BANANAS | 101112 | |||||||
Sheet2 |
Sub CMBO()
Dim AR1() As Variant: AR1 = Range("B1:C" & Range("B" & Rows.Count).End(xlUp).Row).Value2
Dim AR2() As Variant: AR2 = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row).Value2
Dim r As Range: Set r = Range("G1")
With CreateObject("System.Collections.ArrayList")
For i = 1 To UBound(AR2)
For j = 1 To UBound(AR1)
.Add AR2(i, 1) & ";" & AR1(j, 1) & ";" & AR1(j, 2)
Next j
Next i
Set r = r.Resize(.Count)
r.Value2 = Application.Transpose(.toArray)
r.TextToColumns DataType:=xlDelimited, Semicolon:=True
End With
End Sub
Thanks you very much, just one thing if you can add please it doesn't work if there is only one value in column E there needs to be more for it to work
Blank_2_Years (3).xlsx
B C D E F G H I 1 APPLES 123 A0001 A0001 APPLES 123 2 ORANGES 456 A0002 A0001 ORANGES 456 3 PEARS 789 A0003 A0001 PEARS 789 4 BANANAS 101112 A0004 A0001 BANANAS 101112 5 A0005 A0002 APPLES 123 6 A0006 A0002 ORANGES 456 7 A0002 PEARS 789 8 A0002 BANANAS 101112 9 A0003 APPLES 123 10 A0003 ORANGES 456 11 A0003 PEARS 789 12 A0003 BANANAS 101112 13 A0004 APPLES 123 14 A0004 ORANGES 456 15 A0004 PEARS 789 16 A0004 BANANAS 101112 17 A0005 APPLES 123 18 A0005 ORANGES 456 19 A0005 PEARS 789 20 A0005 BANANAS 101112 21 A0006 APPLES 123 22 A0006 ORANGES 456 23 A0006 PEARS 789 24 A0006 BANANAS 101112 Sheet2
VBA Code:Sub CMBO() Dim AR1() As Variant: AR1 = Range("B1:C" & Range("B" & Rows.Count).End(xlUp).Row).Value2 Dim AR2() As Variant: AR2 = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row).Value2 Dim r As Range: Set r = Range("G1") With CreateObject("System.Collections.ArrayList") For i = 1 To UBound(AR2) For j = 1 To UBound(AR1) .Add AR2(i, 1) & ";" & AR1(j, 1) & ";" & AR1(j, 2) Next j Next i Set r = r.Resize(.Count) r.Value2 = Application.Transpose(.toArray) r.TextToColumns DataType:=xlDelimited, Semicolon:=True End With End Sub
Sub CMBO()
Dim r As Range: Set r = Range("G1")
Dim er As Range: Set er = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
Dim AR1() As Variant: AR1 = Range("B1:C" & Range("B" & Rows.Count).End(xlUp).Row).Value2
Dim AR2() As Variant
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
If er.Cells.Count = 1 Then
ReDim AR2(1 To 1, 1 To 1)
AR2(1, 1) = er.Value2
Else
AR2 = er.Value2
End If
With CreateObject("System.Collections.ArrayList")
For i = 1 To UBound(AR2)
If Not SD.exists(AR2(i, 1)) Then
SD.Add (AR2(i, 1)), 1
For j = 1 To UBound(AR1)
.Add Join(Array(AR2(i, 1), AR1(j, 1), AR1(j, 2)), ";")
Next j
End If
Next i
Set r = r.Resize(.Count)
r.Value2 = Application.Transpose(.toArray)
r.TextToColumns DataType:=xlDelimited, Semicolon:=True
End With
End Sub
Thank you very much that workedHow about this?
VBA Code:Sub CMBO() Dim r As Range: Set r = Range("G1") Dim er As Range: Set er = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row) Dim AR1() As Variant: AR1 = Range("B1:C" & Range("B" & Rows.Count).End(xlUp).Row).Value2 Dim AR2() As Variant Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary") If er.Cells.Count = 1 Then ReDim AR2(1 To 1, 1 To 1) AR2(1, 1) = er.Value2 Else AR2 = er.Value2 End If With CreateObject("System.Collections.ArrayList") For i = 1 To UBound(AR2) If Not SD.exists(AR2(i, 1)) Then SD.Add (AR2(i, 1)), 1 For j = 1 To UBound(AR1) .Add Join(Array(AR2(i, 1), AR1(j, 1), AR1(j, 2)), ";") Next j End If Next i Set r = r.Resize(.Count) r.Value2 = Application.Transpose(.toArray) r.TextToColumns DataType:=xlDelimited, Semicolon:=True End With End Sub