Please help!

[a_yr]

I have a list of vendors created in different companies:
Vendor Name Vendor No Company No
A 1 1515
A 1 1516
B 2 2515
C 3 1515
C 3 1516
C 3 2515

I have to create a list like this:

A 1 1515 1516
B 2 2515
C 3 1515 1516 2515
I am not that strong in VBA, tried several ways to do it but none of them worked. Please help...

 

[MickG]

Try this results start "F1"

[COLOR="Navy"]Sub[/COLOR] MG14Nov38
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Twn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Twn = Dn & Dn(, 2)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            .Add Twn, Array(Dn, 0, n)
            Cells(n, 5) = Dn: Cells(n, 6) = Dn(, 2): Cells(n, 7) = Dn(, 3)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Twn)
                Q(1) = Q(1) + 1
                Cells(Q(2), Q(1) + 7) = Dn.Offset(, 2)
            .Item(Twn) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[a_yr]

Thank you, Mick, for your help. I tried to run but it does not want to work... Do not know what to check... Please direct me...

 

[Asala42]

I have a list of vendors created in different companies:
Vendor Name Vendor No Company No
A 1 1515
A 1 1516
B 2 2515
C 3 1515
C 3 1516
C 3 2515

I have to create a list like this:

A 1 1515 1516
B 2 2515
C 3 1515 1516 2515
I am not that strong in VBA, tried several ways to do it but none of them worked. Please help...

I have a lazier approach, but it will only work if the Company number is always numeric (not anything like A-10 for example).

Add to your table an "Occurance" column. Using a formula similar to:
=COUNTIF($A$2:A2,A2)

This should give the integer count of each team entry.

You can use this to create a pivot table with the output you're looking for:
1) Vendor Name and Number in the Row Labels
2) Occurance in hte Column Label
3) Min or Max of Company Number in Values

-Remove subtotals
-Set Pivot Display options to Classic

 

[MickG]

Sorry, I did not see you Header row !!!
Try this:-
With you data sheet open,And you Data in columns "A,B & C"
Right click the sheet tab.
Select " View Code", Vb window opens
Paste Code below, into Blank window.
Close Vb Window.
Double click Cell "A1"
Code should run and Results Appear, starting "E2"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rng As Range
Dim Dn As Range
Dim n As Long
Dim Twn As String
Dim Q
If Target.Address = "$A$1" Then
n= 1
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    Twn = Dn & Dn(, 2)
        If Not .Exists(Twn) Then
            n = n + 1
            .Add Twn, Array(Dn, 0, n)
            Cells(n, 5) = Dn: Cells(n, 6) = Dn(, 2): Cells(n, 7) = Dn(, 3)
        Else
            Q = .Item(Twn)
                Q(1) = Q(1) + 1
                Cells(Q(2), Q(1) + 7) = Dn.Offset(, 2)
            .Item(Twn) = Q
        End If
Next
End With
End If
End Sub

Mick

 

[a_yr]

Thank you, Mick. It is working! Now I will have to fix it a bit as I have more than 2 companies. Company numbers have to be copied one by one from a column into a row. Each company number has to be in its own cell so that eventually we will have company numbers by columns, like all 1515 will be in one column, all 1516 will be in another one etc... Thank you again for your help...