1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

  3. 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

Discussion in 'VBA Macros' started by Nishu, Feb 6, 2018.

  1. Nishu

    Nishu New Member

    Messages:
    21
    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.

    Attached Files:

  2. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,819
    Assuming windows machine. Something like below. Just the values, apply format as needed.

    Code (vb):
    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
  3. Nishu

    Nishu New Member

    Messages:
    21
    Is there any other way to write this in another simple method.
  4. Marc L

    Marc L Excel Ninja

    Messages:
    4,189
    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.
  5. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,819
    "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.
  6. Nishu

    Nishu New Member

    Messages:
    21
    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 :)
  7. Nishu

    Nishu New Member

    Messages:
    21
    Yah.. have used split but not meeting my exception, everything got jumbled :( anyway will try
  8. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,819
    Personally I think RegEx is easier to understand and much simpler to code... but here's version using Split function.

    Code (vb):
    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
  9. Marc L

    Marc L Excel Ninja

    Messages:
    4,189


    I would directly use Split and check via UBound …​
  10. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,819
    Taking Marc's suggestion.
    Code (vb):
    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
     
  11. Nishu

    Nishu New Member

    Messages:
    21


    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.

    Attached Files:

  12. Nishu

    Nishu New Member

    Messages:
    21
    Hi Chihiro,
    Hope you are doing well, If you get time please have a look on the above problem.
  13. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,819
    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.
  14. Nishu

    Nishu New Member

    Messages:
    21
    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
  15. NARAYANK991

    NARAYANK991 Excel Ninja

    Messages:
    16,619
    Hi ,

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

    Narayan
  16. Nishu

    Nishu New Member

    Messages:
    21
    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.

    Attached Files:

  17. NARAYANK991

    NARAYANK991 Excel Ninja

    Messages:
    16,619
    Hi ,

    See the attached file.

    Narayan

    Attached Files:

  18. Nishu

    Nishu New Member

    Messages:
    21
    This one is perfect... :) Thank alot .... :)
  19. Nishu

    Nishu New Member

    Messages:
    21
    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.

    Attached Files:

Share This Page