Search code examples
excelexcel-formulaexcel-2010excel-2007vba

Split a string of text in a cell and have it correlate against multiple columns


I have a string of text that I want to split up. But at the same time when the string is split, I need it to pull the following data that is associated with it. I have tried transposing, and I have tried the split function. But it does not do what I need it to do. Any ideas or suggestions that I can try. Here is an example of what I am trying to accomplish:

enter image description here

This is what I currently have and changed and tried to modify from the first piece of code. Still cant figure it out:

Sub Test()
Dim rng As Range, Lstrw As Long, c As Range, d As Range
Dim SpltRng As Range
Dim i As Integer
Dim j As Integer
Dim Orig As Variant
Dim txt As String

Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:A" & Lstrw)

For Each c In rng.Cells
    Set SpltRng = c.Offset(, 1)
    txt = SpltRng.Value
    Orig = Split(txt, ",")

Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B2:B" & Lstrw)

For Each d In rng.Cells
Set SpltRng = d.Offset(, 1) + 1


    For i = 0 To LBound(Orig)
        Cells(Rows.Count, "L").End(xlUp).Offset(1) = c
        Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(i)

      For j = 0 To LBound(Orig)
        Cells(Rows.Count, "L").End(xlUp).Offset(1) = d
        Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(j)
            Next j

         Next i

       Next d
   Next c

 End Sub

Solution

  • You are way over thinking it, you only need to add one line to the code rovided by @Davesexcel:

    Sub ChickatAH()
    Dim rng As Range, Lstrw As Long, c As Range
    Dim SpltRng As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String
    
    Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A2:A" & Lstrw)
    
    For Each c In rng.Cells
        Set SpltRng = c.Offset(, 1)
        txt = SpltRng.Value
        Orig = Split(txt, " ")
    
        For i = 0 To UBound(Orig)
            Cells(Rows.Count, "L").End(xlUp).Offset(1) = c
            Cells(Rows.Count, "L").End(xlUp).Offset(, 1) = Orig(i)
            'New Line
            Cells(Rows.Count, "L").End(xlUp).Offset(, 2).Resize(, 3).Value = c.Offset(, 2).Resize(, 3).Value
        Next i
    
    Next c
    
    End Sub