Arrange data in Horizontal.

[avisoft20]

Hello Sir,

I have a database ,

For Example table given below :

Row	State	City	Pin
1	Delhi	Delhi	110092
2	Punjab	Punjab	110097
3	Punjab	Chandigarh	110102
4	Uttar Pradesh	Lucknow	110107
5	Uttar Pradesh	Kanpur	110112
6	Uttar Pradesh	Agra	110117
7	Uttar Pradesh	Meruth	110117
8	Uttar Pradesh	Matrhura	110127
9	Uttar Pradesh	Mathura-1	110127

<tbody>
</tbody>

Ans answer will ,

State	Pin	City	City-1
Delhi	110092	Delhi
Punjab	110097	Punjab
Punjab	110102	Chandigarh
Uttar Pradesh	110107	Lucknow
Uttar Pradesh	110112	Kanpur
Uttar Pradesh	110117	Agra	Meruth
Uttar Pradesh	110127	Matrhura	Meruth-1

<tbody>
</tbody>

In rows no 6 & 7 City-Agra and Meruth have same pin code and rows no 8 & 9 city - Mathura and Mathura-1 have same pin code.I want that if same pin code with same state found city will be in next column in separate cell.

 

[MickG]

Try this:-
Your data assumed to start "A1" with the Word "State".(ex column 2 from your Thread Data)
Results start "E1".

[COLOR="Navy"]Sub[/COLOR] MG15Oct41
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 3)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    txt = Dn.Value & Dn.Offset(, 2).Value
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(txt) [COLOR="Navy"]Then[/COLOR]
        n = n + 1
        Ray(n, 1) = Dn.Value
        Ray(n, 2) = Dn.Offset(, 2).Value
        Ray(n, 3) = Dn.Offset(, 1).Value
        Dic.Add txt, Array(n, 3)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic(txt)
            Q(1) = Q(1) + 1
            [COLOR="Navy"]If[/COLOR] Q(1) > UBound(Ray, 2) [COLOR="Navy"]Then[/COLOR] ReDim Preserve Ray(1 To Rng.Count, 1 To Q(1))
            Ray(Q(0), Q(1)) = Dn.Offset(, 1).Value
            Ray(1, Q(1)) = "City-" & Q(1) - 3
            oMax = Application.Max(oMax, Q(1))
        Dic(txt) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Range("E1").Resize(Dic.Count, oMax)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[avisoft20]

Thank You So much Mr.MickG
This code is working.


Again Thank you so much

 

[MickG]

You're welcome