• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

how to create multiple rows in vba if multiples values are in single cells

Nishu

New Member
Hi,
I have a data where multiples values are in single cell, i have to arrange all values separately. could you please help me out. Your suggestion is highly appreciated.
 

Attachments

  • Segregate.xlsx
    10 KB · Views: 21
Assuming windows machine. Something like below. Just the values, apply format as needed.

Code:
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
 
Hi !

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.
 
"Simple" depends on your starting data set.

If strict data format is enforced on initial data, sure it can be simplified quite a bit.

However, since you had different types of delimiter separating each... I assumed those could change from existing sample. Hence, I used RegEx pattern to just extract words (excludes special characters and space).

Other than that, code is just simple string concatenation and using split function to put it into array to return to new range.
 
Yes, you have used RegEx that makes little bit complicated to understand basic users, actually i have to teach to my student. will try to find another way :)
 
Hi !

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.
Yah.. have used split but not meeting my exception, everything got jumbled :( anyway will try
 
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
 
Taking Marc's suggestion.
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)
    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, 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.
 

Attachments

  • Segregate.xlsm
    19.2 KB · Views: 5
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.
Hi Chihiro,
Hope you are doing well, If you get time please have a look on the above problem.
 
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.
 
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.
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.

Sub Test()
Dim arO, resAr(), i As Long, j As Long, k As Long, aa As Long, bb As Long
Dim rcol As New Collection
arO = Range("A2:G" & 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) & "," & arO(i, 7)
Next
Next
Next

ReDim resAr(1 To rcol.Count, 1 To 7)
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, 7).Value = Range("A1:G1").Value
Range("J2").Resize(UBound(resAr), 7) = resAr

End Sub
 
Hi ,

Please upload a workbook with enough data in it , covering all possible variations.

Narayan
Hi Narayan,
Please have a look, You may see i want to apply split only on column "A" and "B" or any specific column. Attached is the file for your reference.
Please feel free to ask me for any details.
 

Attachments

  • Segregate.xlsm
    21.9 KB · Views: 2
Hello All,
Hope you are doing well, I have the attached file where code breaks cells where "/" and "," found in cells, But if i want to break only those cells where is "/" that mean "," contains cell will remain as it is. could you please advise how to do as per attached sheet.
 

Attachments

  • Test (1).xlsm
    18.1 KB · Views: 2
Back
Top