Joint two column into one

[Vanda_a]

Dear all

Please kindly adjust my code to a better one. Esp the red part. I have no idea how to deal with selected cells or range

Sub Test()

Dim Row As Integer
Dim Col As Integer
Dim Cels As Range
Dim Rng As Range

Row = ActiveCell.Row
Col = ActiveCell.Column + 2
Set Rng = Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.End(xlDown).Row, (ActiveCell.Column + 1))) ''In fact I want a selected range

For Each Cels In Rng
    Cells(Row, Col) = Cels
    Row = Row + 1
Next Cels

End Sub

The code does something like below table

	A	B	C
1	1	A	1
2	2	B	A
3	3	C	2
4	4	D	B
5	5	E	3
6			C
7			4
8			D
9			5
10			E

<tbody>
</tbody>

 

[hiker95]

Vanda_a,

Here is another macro solution for you to consider that uses two arrays in memory, that is based on your screenshot where columns A, and, B, contain the same number of rows.

You can change the raw data worksheet name in the macro.

Sample raw data, and, results:

Excel 2007
	A	B	C
1	1	A	1
2	2	B	A
3	3	C	2
4	4	D	B
5	5	E	3
6			C
7			4
8			D
9			5
10			E
11
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ReorgData()
' hiker95, 07/03/3025, ME865468
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  a = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
  ReDim o(1 To UBound(a, 1) * 2, 1 To 1)
  For i = 1 To UBound(a, 1)
      j = j + 1: o(j, 1) = a(i, 1)
      j = j + 1: o(j, 1) = a(i, 2)
  Next i
  .Range("C1:C" & .Range("C" & Rows.Count).End(xlUp).Row).ClearContents
  .Range("C1").Resize(UBound(o, 1)).Value = o
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

 

[Vanda_a]

  ReDim o(1 To UBound(a, 1) * 2, 1 To 1)

I have seen Lbound to Ubound but not this one. Please kindly help to explain above code. Due to my knowledge, I cant understand.

Thank you very much

 

[Vanda_a]

This one too please

.Range("D1").Resize(UBound(o, 1)).Value = o

 

[Rick Rothstein]

While you are waiting for hiker95 to answer your questions, I have another macro for you to consider... notice that it does not use any loops!

Sub ReorganizeData()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & 2 * LastRow) = Application.Transpose(Split(Join(Evaluate( _
                                "TRANSPOSE(A1:A" & LastRow & "&CHAR(1)&B1:B" & _
                                LastRow & ")"), Chr(1)), Chr(1)))
End Sub

 

[Vanda_a]

While you are waiting for hiker95 to answer your questions, I have another macro for you to consider... notice that it does not use any loops!

Sub ReorganizeData()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & 2 * LastRow) = Application.Transpose(Split(Join(Evaluate( _
                                "TRANSPOSE(A1:A" & LastRow & "&CHAR(1)&B1:B" & _
                                LastRow & ")"), Chr(1)), Chr(1)))
End Sub

Cool I learned more. May I have a question pls. This mark " * " means multiple?

Range("C1:C" & 2 [COLOR=#ff0000]*[/COLOR] LastRow)[\code]
Thank you so much

 

[Rick Rothstein]

Cool I learned more. May I have a question pls. This mark " * " means multiple?

Range("C1:C" & 2 [COLOR=#ff0000]*[/COLOR] LastRow)[\code]
[/QUOTE]
Yes... the range you are going to fill has twice as many cells as either column (when starting from Row 1, LastRow is also the number of cells in the column as well as being the row number for the last filled cell).

 

[hiker95]

Vanda_a,

Have you tried my macro?

I have seen Lbound to Ubound but not this one. Please kindly help to explain above code. Due to my knowledge, I cant understand.

It is a personal preference, and, it can be written several ways:

  a = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
  'Creats the a array: Variant/Variant(1 To 5, 1 To 2)  

  'The following three lines of code create the same size o array
  ReDim o(1 To UBound(a, 1) * 2, 1 To 1)
  'Creats the o array:  Variant/Variant(1 To 10, 1 To 1)
  
  ReDim o(LBound(a, 1) To UBound(a, 1) * UBound(a, 2), 1 To 1)
  'Creats the o array:  Variant/Variant(1 To 10, 1 To 1)  

  ReDim o(LBound(a, 1) To UBound(a, 1) * 2, 1 To 1)
  'Creats the o array:  Variant/Variant(1 To 10, 1 To 1)

 

[hiker95]

Vanda_a,

This one too please

  .Range("D1").Resize(UBound(o, 1)).Value = o

It is a personal preference, and, it can be written several ways:

  .Range("C1").Resize(UBound(o, 1)).Value = o
  
  .Range("C1").Resize(UBound(o, 1), UBound(o, 2)).Value = o

 

[Vanda_a]

Vanda_a,

Have you tried my macro?

Yes. It works as what I expected just one small thing. It does paste from C1.

Thanks for your explanation