Home > Mobile >  Transforming two columns (first with repeat values, second with unique values) in one columns
Transforming two columns (first with repeat values, second with unique values) in one columns

Time:03-03

How can I transform two columns like that

A    B         
foo  foo1
foo  foo2
foo  foo3
faa  faa1
faa  faa2
fee  fee1
fee  fee2

In the following structure

foo
foo1,foo2,foo3
faa
faa1,faa2
fee
fee1,fee2

What I have tried to do so far is to create my loop.

Sub DowithIf()

rw = 11
cl = 2
erw = 1000

Do While rw < erw
   
        
        
    rw = rw   1
Loop


End Sub

But first thing I do not how to do is to detect that first value of column A (foo) is the same that second value of column A (foo). Go through A column if value is new save it as mention in the code above and save value in column B, is A2 equal that A1 if so save foo2, is A3 equal that A4, yes, save foo3, is A4 equal that A3 no, then new value...

EDIT:

enter image description here

CodePudding user response:

You firstly must learn that a question must contain a piece of code, even if it does not work as you need. Then, it is also good to frequently check your question and answer clarification questions. Now, hopping that you understood my point, I make an exception and try showing a piece of code able to do what (I understood) you need. It should be very fast, using arrays and a Dictionary:

Sub processTwoColumns()
  Dim sh As Worksheet, lastR As Long, arr, arrFin2C, arrfinUnique
  Dim i As Long, k As Long, dict As Object
  
  Set sh = ActiveSheet     'use here the sheet you need
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row on A:A column
  arr = sh.Range("A1:B" & lastR).value                      'place the range to be processed in an array, for faster iteration
  ReDim arrFin2C(1 To UBound(arr), 1 To 1)                  'reDim the array to keep first way of returning
  
  Set dict = CreateObject("Scripting.Dictionary")           'Set the Scripting Dictionary object
  For i = 1 To UBound(arr)                                  'iterate between the array rows
        arrFin2C(i, 1) = arr(i, 1) & " " & arr(i, 2)        ' building the array to be return, by concatenation of the two columns
        dict(arr(i, 1)) = dict(arr(i, 1)) & ", " & arr(i, 2)'place in a dictionary unique keys and items separated by ", "
  Next i
  sh.Range("D1:D" & lastR).value = arrFin2C                 'drop the array content
  
  ReDim arrfinUnique(1 To dict.count * 2, 1 To 1): k = 1    'reDim the array necessary to keep the processed result for the second way
  For i = 1 To dict.count - 1                               'iterate between the dictionary keys/items
    arrfinUnique(k, 1) = dict.Keys()(i): k = k   1          'place in the array the dictionary key
    arrfinUnique(k, 1) = Mid(dict.items()(i), 3): k = k   1 'place in the array the dictionary item (without leading ", ")
  Next i
  sh.Range("F2").Resize(UBound(arrfinUnique), 1).value = arrfinUnique  'drop the array content
End Sub

The above code will return the first required version in column "D:D", starting from the first row and the second one in "F:F", starting from the second row. The code can be easily adapted to return in any other place/sheet...

  •  Tags:  
  • vba
  • Related