PDA

View Full Version : Solved: Merge column by select them



parscon
11-21-2012, 08:00 AM
I have excel list and I need merge some column, VBA code that can merge data in column . for example I have a data on column A like:


A1 DATA1
A2 DATA2
A3 DATA3


when select A1 to A3 merge them to first column that I select that mean

will be A1 = DATA1,DATA2,DATA3

Another example I want to merge data on column B201-B202-B203

When select B201-B202-B203 merge them to B201 all of them

B201 DATA201
B202 DATA202
B203 DATA203

when merge will be B201= DATA201,DATA202, DATA203

parscon
11-21-2012, 09:26 AM
I created This code but I need another thing and that's delete the data on other cell that I selected except the first cell that I selected .


Option Explicit
Sub MergeMacro()
Dim rMyRange As Range
Dim rCurCell As Range
Dim sResult As String
Dim iCount As Integer
Set rMyRange = ActiveWindow.RangeSelection
iCount = 1
For Each rCurCell In rMyRange
If rCurCell.Text <> "" Then
If iCount > 1 Then sResult = sResult & ","
sResult = sResult & rCurCell.Text
iCount = iCount + 1
End If
Next

rMyRange.Offset(0, 0).Resize(1, 1).Value = sResult

End Sub

parscon
11-21-2012, 10:38 AM
It is done .


Option Explicit
Sub MergeMacro()
Dim rMyRange As Range
Dim rCurCell As Range
Dim sResult As String
Dim iCount As Integer
Set rMyRange = ActiveWindow.RangeSelection
iCount = 1
For Each rCurCell In rMyRange
If rCurCell.Text <> "" Then
If iCount > 1 Then sResult = sResult & ","
sResult = sResult & rCurCell.Text
iCount = iCount + 1
End If
Next

rMyRange.Offset(0, 0).Resize(1, 1).Value = sResult

ActiveWindow.RangeSelection.Offset(1).Resize(1, 1).ClearContents

End Sub

parscon
11-21-2012, 11:30 AM
Now just I have a small problem ,

For example when I select data range and run this code it will delete 1 row after the selected range . how can I fix it ?

Please help me .