A while ago I used a forum and posted a problem which was solved by using a VBA script. This script works most of the time but not always. The original problem I had was that I get given an excel sheet with 3 columns detailing a description, a part number and a location. I needed duplicate description and part number lines to combine the location and add a quantity column.

**Example original:**

Description Part Number Location

ABC 123 C1

DEF 456 C2

ABC 123 C3

DEF 456 C4

**Example output:**

Description Part Number Location Qty

ABC 123 C1, C3 2

DEF 456 C2, C4 2

Below is the script I have been given. If you run the script not all of the data comes across (about 10% is missing from the output). The original list can have up to 1000 lines. I have been looking at the code for hours now and have to admit it is beyond me to fully understand. Can any smarties out here help? Thank you so much in advance for any help.

Mario

Dim a, i As Long, j As Long, n As Long, z

ReDim z(1 To 2)

With Sheets("Sheet5").Range("a1").CurrentRegion

a = .Value

End With

With CreateObject("Scripting.Dictionary")

.comparemode = 1

For i = 1 To UBound(a, 1)

If Not .exists(a(i, 2)) Then

n = n + 1

z(1) = n

Set z(2) = CreateObject("Scripting.Dictionary")

z(2).comparemode = 1

z(2)(a(i, 1)) = Empty

For j = 1 To UBound(a, 2)

a(n, j) = a(i, j)

Next

.Item(a(i, 2)) = z

Else

z = .Item(a(i, 2))

If z(2).exists(a(i, 1)) Then

a(z(1), 3) = Join$(Array(a(z(1), 3), a(i, 3)), ", ")

z(2)(a(i, 1)) = Empty

.Item(a(i, 2)) = z

End If

End If

Next

End With

With Sheets.Add

.Range("A1").Resize(n, UBound(a, 2)).Value = a

.Columns.AutoFit

.Activate

End With