PDA

View Full Version : [SOLVED] Loop through the record and summarized



pivotguy
09-29-2016, 02:16 PM
I have 2 fields - Person Name and territory. One Person can have multiple territory. I would like to have one row for each person and second column territories separated by semi colon.The original file contains thousands of records. Any suggestionhow to do through a VBA. See the attached sample file.


INPUT FILE
=======

Name ----------->Territory
===================

John Barnes --->345
John Barnes --->234

OUTPUT
=======

John Barnesą345;234

mana
09-30-2016, 07:21 AM
Option Explicit

Sub test()
Dim dic As Object
Dim ws1 As Worksheet, ws2 As Worksheet
Dim v
Dim s As String
Dim i As Long
Dim k, n As Long

Set ws1 = Worksheets("Input")
Set ws2 = Worksheets("Output")

v = ws1.Range("a1").CurrentRegion.Value

Set dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(v)
s = v(i, 1)
If Not dic.exists(s) Then
Set dic(s) = CreateObject("system.collections.arraylist")
End If
dic(s).Add v(i, 2)
Next

ws2.Range("a1").ClearContents

For Each k In dic.keys
ws2.Range("a1").Offset(n).Value = k
ws2.Range("b1").Offset(n).Value = Join(dic(k).toarray, ";")
n = n + 1
Next

End Sub

MickG
09-30-2016, 07:25 AM
Try this, In sheet "Input" for results on sheet "Output"


Private Sub Test()
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn.Offset(, 1).Value
Else
.Item(Dn.Value) = .Item(Dn.Value) & ";" & Dn.Offset(, 1).Value
End If
Next
Sheets("Output").Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
End With
End Sub

pivotguy
09-30-2016, 11:33 AM
Mana and MickG - Both the solutions worked. I really appreciate you time and effort. Have a great Day. This issue is Resolved.

MickG
10-01-2016, 03:34 AM
You're welcome