VBA: copy and paste in horizontal

[Nelson78]

Hello everybody.

I'm struggling with a database in which some data (in the example, names of cities) could be repeated a lot of times.

I need to report in another sheet the data, and then report in horizontal the related datas.

See what I mean in the image https://imgur.com/a/HMMWHae


I have succeed in copy and paste the first column without duplicates. Now I need some hints to complete the job, atleast in what sort of approach is needed.

Thank's.

 

[Fluff]

How about

Sub Copytrans()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Dic(Cl.Value) = Dic(Cl.Value) & Cl.Offset(, 1).Value & "|" & Cl.Offset(, 2).Value & "|"
   Next Cl
   
   For Each Ky In Dic.keys
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         .Offset(1).Value = Ky
         .Offset(1, 1).Resize(, UBound(Split(Dic(Ky), "|")) + 1).Value = Split(Dic(Ky), "|")
      End With
   Next Ky
End Sub

 

[Nelson78]

How about

Sub Copytrans()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Dic(Cl.Value) = Dic(Cl.Value) & Cl.Offset(, 1).Value & "|" & Cl.Offset(, 2).Value & "|"
   Next Cl
   
   For Each Ky In Dic.keys
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         .Offset(1).Value = Ky
         .Offset(1, 1).Resize(, UBound(Split(Dic(Ky), "|")) + 1).Value = Split(Dic(Ky), "|")
      End With
   Next Ky
End Sub

It works fine. Thank you.

 

[Fluff]

Glad to help & thanks for the feedback

 

[Nelson78]

How about

Sub Copytrans()
   Dim Cl As Range
   Dim Dic As Object
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Dic(Cl.Value) = Dic(Cl.Value) & Cl.Offset(, 1).Value & "|" & Cl.Offset(, 2).Value & "|"
   Next Cl
   
   For Each Ky In Dic.keys
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         .Offset(1).Value = Ky
         .Offset(1, 1).Resize(, UBound(Split(Dic(Ky), "|")) + 1).Value = Split(Dic(Ky), "|")
      End With
   Next Ky
End Sub

Hi @Fluff, I've adapted correctly the code for my job, except for one aspect: on the receiving sheet I need column B and column C empty, beginning to report in horizontal from column D (see image).

https://imgur.com/a/GJ8fZb2

 

[Fluff]

Simply change this

With Sheets("Sheet2").Range("[COLOR=#ff0000]D[/COLOR]" & Rows.Count).End(xlUp)

 

[Nelson78]

Simply change this

With Sheets("Sheet2").Range("[COLOR=#ff0000]D[/COLOR]" & Rows.Count).End(xlUp)

Not exaclty: column A has to remain as before, column B and C empty, then from column D the other data.

 

[Fluff]

In that case change this

.Offset(1, 3).Resize

 

[Nelson78]

In that case change this

.Offset(1, 3).Resize

Yes, that's it.

But what about the cells format?
After moving, they all seem to became "general", but some are in a different format.

 

[Fluff]

In what way?