Can you confirm that this is what you expected (before we move on to PowerPoint)
(Unsophiticated) Pivot Table seems to give you what you want based on the manipulated values in Sheet1, which have been arrived at as follows
-Data copied to Sheet1 for manipulation
- “multi-value” cell (columE) text Split and values placed into array
- required rows inserted
- values assigned from row above
- single customer name inserted in each row from array
The code:
Select Code copy to clipboard
Sub DelimitAndAddRows()
'copy data to allown clean start after each test
Sheets("Data").Cells.Copy
Sheets("sheet1").Range("A1").PasteSpecial xlAll
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim myfile As String
Dim myCount As Long, lastRow As Long, c As Long, r As Long
Dim myArray() As String
lastRow = ws.Range("A1").CurrentRegion.Rows.Count
For r = lastRow To 2 Step -1
myCount = UBound(Split(ws.Cells(r, 5).Value, ";"))
If myCount > 0 Then
myArray() = Split(ws.Cells(r, 5).Value, ";") ' split text in cell containing multiple values
For i = 1 To myCount
ws.Rows(r + 1).EntireRow.Insert Shift:=xlDown
For c = 1 To 8
ws.Cells(r + 1, c) = ws.Cells(r, c) ' copy values from row above
Next c
ws.Cells(r + 1, 5) = Trim(myArray(i)) 'Trim removes extraneous blank cells
Next i
ws.Cells(r, 5) = Trim(myArray(0))
Erase myArray
Else
End If
Next r
End Sub
Bookmarks