Separate Words in Cell

**Pillepop010** · 07-12-2010, 08:29 AM

Hello everybody

First of all: Great Forum. So far I found a lot of super tips and HowTo’s which helped me get a lot of my “Challenges” resolved. But here is something I have no Idea who to get this done and hope somebody can help me.

I have an Excel (2007) sheet in an Format like that

SKU______Product_________________________Price
123-456___BrandA; BrandB; BrandC; BrandD_____100 €

As you can see, there are multiple Products listed

What I’m trying to figure out is a way to separate all Products to get a result like that:
SKU_______Product_____Price
123-456____BrandA_____100 €
123-456____BrandB_____100 €
123-456____BrandC_____100 €
123-456____BrandD_____100 €

Anybody any Idea how this can be resolved?
Any Help would be much appreciated.

Cheers

Pille

**StephenR** · 07-12-2010, 08:40 AM

Try this, which puts results in sheet2.

Sub x()

Dim r As Long, v

For r = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    v = Split(WorksheetFunction.Trim(Sheet1.Cells(r, 2)), ";")
    With Sheet2.Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(v) + 1)
        .Offset(, 1).Value = Application.Transpose(v)
        .Value = Sheet1.Cells(r, 1)
        .Offset(, 2) = Sheet1.Cells(r, 3)
    End With
Next r
    
End Sub

**Marcol** · 07-12-2010, 09:10 AM

Another macro might be

Takes data from sheet 1 and inserts in sheet 3

Option Explicit

Sub SplitTextStrings()
    Dim LastRow As Long, NR As Long
    Dim n As Integer, i As Integer
    Dim arrSplit As Variant
    
    Sheets("Sheet1").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For n = 2 To LastRow
        arrSplit = Split(Range("B" & n), ";")
        For i = LBound(arrSplit) To UBound(arrSplit)
            With Sheets("Sheet3")
                NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                .Range("A" & NR) = Range("A" & n)
                .Range("B" & NR) = Trim(arrSplit(i))
                .Range("C" & NR) = Range("C" & n)
            End With
        Next
    Next

    With Sheets("Sheet3")
        .Columns("C:C").NumberFormat = "#,##0.00 [$€-1]"
        .Activate
    End With
End Sub

Hope this helps

**Pillepop010** · 07-12-2010, 09:38 AM

Hi StephenR, Marcol

Both of the Macros are working fine

; unfortunately I tried to adopt it to the sheet I'm using (didn't think it would be so complicated)…..without any success

. So I made a copy of what the Original is an attached it to this post. Its pretty much the same, just little different. Can you please help me again?

So far: many Thanks and much appriciated

Thanks
Pille

**StephenR** · 07-12-2010, 09:50 AM

Try this:

Sub x()

Dim r As Long, v

Sheet1.Range("A1", Sheet1.Range("A1").End(xlToRight)).Copy Sheet2.Range("A1")

For r = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    v = Split(WorksheetFunction.Trim(Sheet1.Cells(r, 3)), ",")
    With Sheet2.Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(v) + 1)
        .Offset(, 2).Value = Application.Transpose(v)
        .Resize(, 2).Value = Sheet1.Cells(r, 1).Resize(, 2).Value
        .Offset(, 3).Resize(, 5).Value = Sheet1.Cells(r, 4).Resize(, 5).Value
    End With
Next r

Sheet2.Range("D:H").NumberFormat = "#,##0 ""€"";[Red]-#,##0 ""€"""

End Sub

**Marcol** · 07-12-2010, 10:02 AM

Try this

Option Explicit

Sub SplitTextStrings()
    Dim LastRow As Long, NR As Long
    Dim LastCol As String
    Dim n As Integer, i As Integer
    Dim arrSplit As Variant
    
    Sheets("AsIs").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    LastCol = Split(Cells(1, Columns.Count).End(xlToLeft).Address, "$")(1)
    For n = 2 To LastRow
        arrSplit = Split(Range("C" & n), ",")
        For i = LBound(arrSplit) To UBound(arrSplit)
            With Sheets("Sheet3")
                NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                Range("A" & n & ":B" & n).Copy .Range("A" & NR)
                .Range("C" & NR) = Trim(arrSplit(i))
                Range("D" & n & ":" & LastCol & n).Copy .Range("D" & NR)
            End With
        Next
    Next

    With Sheets("ShouldBe")
        Range("A1:" & LastCol & "1").Copy .Range("A1")
        .Columns("D:" & LastCol).NumberFormat = "#,##0.00 [$€-1]"
        .Activate
    End With
End Sub

Change to suit your sheet names

Hope this helps

[EDIT 1]
Am I in a time warp after the power cut ....

Never saw your post Stephen

[EDIT 2]
I have changed the code to allow for as many countries as you might need