Sub Demo()
Dim arO, resAr(), i as Long, j as Long
Dim matches As Object, matches2 as Object
Dim rcol As New Collection
arO = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
For i = 1 To UBound(arO)
With CreateObject("VBScript.RegExp")
.Pattern = "\w+"
.Global = True
Set matches = .Execute(arO(i, 1))
For Each m In matches
Set matches2 = .Execute(arO(i, 2))
For Each m2 In matches2
rcol.Add m & "," & m2 & "," & arO(i, 3) & "," & arO(i, 4) & "," & arO(i, 5) & "," & arO(i, 6)
Next
Next
End With
Next
ReDim resAr(1 To rcol.Count, 1 To 6)
For i = 1 To rcol.Count
x = Split(rcol(i), ",")
For j = 0 To UBound(x)
resAr(i, j + 1) = x(j)
Next
Next
Range("J1").Resize(1, 6).Value = Range("A1:F1").Value
Range("J2").Resize(UBound(resAr), 6) = resAr
End Sub
Yah.. have used split but not meeting my exception, everything got jumbled anyway will tryHi !
Yes : just think about the logic to apply. Once achieved & valid,
activate Macro recorder and operate manually : you will get a code base.
In case of an optimization need, post here this generated code
with a crystal clear & complete explanation of what you expect for …
A tip : see Split and UBound in VBA inner help.
Sub Demo()
Dim arO, resAr(), i As Long, j As Long, k As Long
Dim rcol As New Collection
arO = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
For i = 1 To UBound(arO)
If InStr(arO(i, 1), ",") Then
x = Split(arO(i, 1), ",")
ElseIf InStr(arO(i, 1), "/") Then
x = Split(arO(i, 1), "/")
Else
x = Array(arO(i, 1))
End If
For j = 0 To UBound(x)
If InStr(arO(i, 2), ",") Then
y = Split(arO(i, 2), ",")
ElseIf InStr(arO(i, 2), "/") Then
y = Split(arO(i, 2), "/")
Else
y = Array(arO(i, 2))
End If
For k = 0 To UBound(y)
rcol.Add Trim(x(j)) & "," & Trim(y(k)) & "," & arO(i, 3) & "," & arO(i, 4) & "," & arO(i, 5) & "," & arO(i, 6)
Next
Next
Next
ReDim resAr(1 To rcol.Count, 1 To 6)
For i = 1 To rcol.Count
x = Split(rcol(i), ",")
For j = 0 To UBound(x)
resAr(i, j + 1) = x(j)
Next
Next
Range("J1").Resize(1, 6).Value = Range("A1:F1").Value
Range("J2").Resize(UBound(resAr), 6) = resAr
End Sub
Sub Demo()
Dim arO, resAr(), i As Long, j As Long, k As Long
Dim rcol As New Collection
arO = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value2
For i = 1 To UBound(arO)
x = Split(arO(i, 1), ",")
If UBound(x) < 2 Then x = Split(arO(i, 1), "/")
If UBound(x) < 2 Then x = Array(arO(i, 1))
For j = 0 To UBound(x)
y = Split(arO(i, 2), ",")
If UBound(y) < 2 Then y = Split(arO(i, 2), "/")
If UBound(y) < 2 Then y = Array(arO(i, 2))
For k = 0 To UBound(y)
rcol.Add Trim(x(j)) & "," & Trim(y(k)) & "," & arO(i, 3) & "," & arO(i, 4) & "," & arO(i, 5) & "," & arO(i, 6)
Next
Next
Next
ReDim resAr(1 To rcol.Count, 1 To 6)
For i = 1 To rcol.Count
x = Split(rcol(i), ",")
For j = 0 To UBound(x)
resAr(i, j + 1) = x(j)
Next
Next
Range("J1").Resize(1, 6).Value = Range("A1:F1").Value
Range("J2").Resize(UBound(resAr), 6) = resAr
End Sub
Personally I think RegEx is easier to understand and much simpler to code... but here's version using Split function.
Code:Sub Demo() Dim arO, resAr(), i As Long, j As Long, k As Long Dim rcol As New Collection arO = Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value2 For i = 1 To UBound(arO) If InStr(arO(i, 1), ",") Then x = Split(arO(i, 1), ",") ElseIf InStr(arO(i, 1), "/") Then x = Split(arO(i, 1), "/") Else x = Array(arO(i, 1)) End If For j = 0 To UBound(x) If InStr(arO(i, 2), ",") Then y = Split(arO(i, 2), ",") ElseIf InStr(arO(i, 2), "/") Then y = Split(arO(i, 2), "/") Else y = Array(arO(i, 2)) End If For k = 0 To UBound(y) rcol.Add Trim(x(j)) & "," & Trim(y(k)) & "," & arO(i, 3) & "," & arO(i, 4) & "," & arO(i, 5) & "," & arO(i, 6) Next Next Next ReDim resAr(1 To rcol.Count, 1 To 6) For i = 1 To rcol.Count x = Split(rcol(i), ",") For j = 0 To UBound(x) resAr(i, j + 1) = x(j) Next Next Range("J1").Resize(1, 6).Value = Range("A1:F1").Value Range("J2").Resize(UBound(resAr), 6) = resAr End Sub
Hi Chihiro,Hi Chihiro, This one if perfect, Thank you. But if i add additional column like "C", which i dont want to split can we do it ? That mean i want to apply split only on column "A" and "B" or any specific column. Attached is the file for your reference.
Below code works fine when there is no Delimiters in column "C", "D" so on.. But any Delimiters come in same column it throw error.Program can't accommodate for whims of user.
You will have to update code supplied if condition changes.
You have basis for using 2 columns. Just adjust column index in array to adjust as needed. Also, there's built in logic for not splitting column if there are no delimiters.
Hi Narayan,Hi ,
Please upload a workbook with enough data in it , covering all possible variations.
Narayan