Solved: Macro to Allocate charges to each client code

[rubbercheck]

Hello all,
I hope someone will be above to help me with this one. Every month I get our delivery service bill in MicroSoft Excel (cvs format); Column A has the codes of companies sometimes separated by semi colons or comas.
I would like a macro that can repeat the lines if it has more than one code and copy it to another sheet. Eg, A2 has 6 company codes so it should be copied to another sheet, and divide the amount in J2 in each row. If it had one code it would also be copied to the other sheet.

See what the result should look like on the Summary worksheet.

Thanks in advance
Rubber c

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim shThis As Worksheet
Dim shSummary As Worksheet
Dim vecRefs As Variant
Dim CountRefs As Long
Dim Lastrow As Long
Dim Nextrow As Long
Dim i As Long, j As Long
Dim cell As Range

Application.ScreenUpdating = False

Set shThis = ActiveSheet
Set shSummary = Worksheets.Add
shSummary.Name = "Summary"
With shThis

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(1).Copy
shSummary.Range("A1").PasteSpecial Paste:=xlPasteValues
Nextrow = 2
For i = 2 To Lastrow

.Cells(i, "A").Value2 = Replace(.Cells(i, "A").Value2, ",", ";")
vecRefs = Split(.Cells(i, "A").Value2, ";")
CountRefs = UBound(vecRefs) - LBound(vecRefs) + 1
.Cells(i, "A").Resize(, 10).Copy
shSummary.Cells(Nextrow, "A").Resize(CountRefs).PasteSpecial Paste:=xlPasteValues
If CountRefs > 1 Then

If vecRefs(CountRefs - 1) = "" Then

ReDim Preserve vecRefs(LBound(vecRefs) To UBound(vecRefs) - 1)
CountRefs = CountRefs - 1
End If

For j = LBound(vecRefs) To UBound(vecRefs)

shSummary.Cells(Nextrow + j, "A").Value2 = vecRefs(j)
Next j
End If

Nextrow = Nextrow + CountRefs
Next i

shSummary.Columns("A:J").AutoFit
End With

Application.ScreenUpdating = True
End Sub
[/vba]

[rubbercheck]

Wow! It works like a charm.
Thanks a million Xld. You rock!