• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Simple matrix transformation

rolo

Member
Hello,

I have a matrix like this (N rows x N columns)

60805

What I need is a macro to convert that matrix to 1 column x N rows matrix (without repetitions and ascending order). Like this:

60806

See attached example

Thanks in advance for your valuable help!
 

Attachments

Marc L

Excel Ninja
Hi !​
A beginner way :​
  • Copy each data column to column F
  • Sort column F
  • Apply the Excel feature Remove Duplicates …
 

rolo

Member
Hello, I was able to code this macro myself! :p


Code:
Function Convert(matrix As Range, destiny As Range)

Dim Counter As Long: Counter = 0

Range(destiny, destiny.End(xlDown)).Clear

Dim cell As Range

For Each cell In matrix

    If cell <> Empty Then
      destiny.Offset(Counter, 0) = cell
      Counter = Counter + 1
   End If

Next cell

Range(destiny, destiny.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo

Range(destiny, destiny.End(xlDown)).Sort Key1:=destiny.Cells(1), Order1:=xlAscending, Header:=xlNo

End Function
Code:
Sub GoConvert()
ActiveSheet.Select 'select sheet where macro must execute
Call Convert(Range("A1:C4"), Range("A10"))
End Sub

Thanks for the other suggestions!
 

Marc L

Excel Ninja
Well done ‼​
As you can see easy stuff can often be achieved with Excel basics …​
Following my post #3 by copying column by column (instead of cell by cell like yours)​
without the need of the source data sheet active :​
Code:
Sub Range2UniqueColumn(Rg As Range, Dest As Range)
        Dim Rc As Range, R&
        Application.ScreenUpdating = False
        Dest.CurrentRegion.Clear
    For Each Rc In Rg.Columns
        Rc.Copy Dest.Offset(R)
        R = R + Rc.Cells.Count
    Next
    With Dest.Resize(R)
        .Sort Dest, xlAscending, Header:=xlNo
        .RemoveDuplicates 1, xlNo
    End With
        Application.ScreenUpdating = True
End Sub

Sub Demo1()
    Range2UniqueColumn Hoja1.[A1].CurrentRegion, Hoja1.[A10]
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Top