Merge data by macro
 

Hi all, I got data in column A and B as show below.

Row A B ......col
1 ID DATA ...headings
2 XY01 Record
3 Time
4 Left
5 XY02 Time
6 Right
7 XY03 System
8 Record
9 Time
10 Left

I need macro which should merge column B data and put result in column
C as shown below

Row A C ......col
1 ID DATA ...headings
2 XY01 Record Time Left
3
4
5 XY02 Time Right
6
7 XY03 System Record Time Left
8
9
10

Basically i need macro to go through column A cells and all those
cells in column B which have value and they are in

same row of blank cells of column A, macro should merge their values
and put result in column E in same row of non

blank cell of column A. Please can any friend can help me on this

Merge data by macro
 

I think that sub resolve what you need:

Sub MergeData()
Dim bEmptyColB As Boolean
Dim bNotEmptyColA As Boolean
Dim nCountRow As Integer
Dim sMergeStr As String

Range("A2").Select

bEmptyColB = False
nCountRow = 0
While Not bEmptyColB
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bEmptyColB = True
Else
bNotEmptyColA = False
sMergeStr = ""
If IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
nCountRow = 0
End If
While Not bNotEmptyColA
If sMergeStr < "" Then
sMergeStr = sMergeStr & " "
End If
sMergeStr = sMergeStr & ActiveCell.Offset(nCountRow, 1).Value
ActiveCell.Offset(nCountRow, 1).Value = ""
nCountRow = nCountRow + 1
If Not IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
Else
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
End If
End If
Wend
End If
Wend

End Sub

Bye, Ste'

Merge data by macro
 

This is a lot shorter and should executer quicker...

Sub CombineData()
Dim X As Long, LastRow As Long, AnchorRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
AnchorRow = 2
For X = AnchorRow + 1 To LastRow + 1
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
Cells(AnchorRow, "B").Value = Join(WorksheetFunction.Transpose( _
Cells(AnchorRow, "B").Resize(X - AnchorRow)), " ")
Cells(AnchorRow + 1, "B").Resize(X - AnchorRow - 1).Clear
AnchorRow = X
End If
Next
End Sub

--
Rick (MVP - Excel)



"SteAXA" wrote in message
...
I think that sub resolve what you need:

Sub MergeData()
Dim bEmptyColB As Boolean
Dim bNotEmptyColA As Boolean
Dim nCountRow As Integer
Dim sMergeStr As String

Range("A2").Select

bEmptyColB = False
nCountRow = 0
While Not bEmptyColB
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bEmptyColB = True
Else
bNotEmptyColA = False
sMergeStr = ""
If IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
nCountRow = 0
End If
While Not bNotEmptyColA
If sMergeStr < "" Then
sMergeStr = sMergeStr & " "
End If
sMergeStr = sMergeStr & ActiveCell.Offset(nCountRow,
1).Value
ActiveCell.Offset(nCountRow, 1).Value = ""
nCountRow = nCountRow + 1
If Not IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
Else
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
End If
End If
Wend
End If
Wend

End Sub

Bye, Ste'

Merge data by macro
 

Perhaps this is a better way to present my code (using a With/EndWith block
to reduce references)...

Sub CombineData()
Dim X As Long, LastRow As Long, AnchorRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
AnchorRow = 2
For X = AnchorRow + 1 To LastRow + 1
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
With Cells(AnchorRow, "B")
.Value = Join(Application.Transpose(.Resize(X - AnchorRow)), " ")
.Offset(1).Resize(X - AnchorRow - 1).Clear
End With
AnchorRow = X
End If
Next
End Sub

--
Rick (MVP - Excel)



"Rick Rothstein" wrote in message
...
This is a lot shorter and should executer quicker...

Sub CombineData()
Dim X As Long, LastRow As Long, AnchorRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
AnchorRow = 2
For X = AnchorRow + 1 To LastRow + 1
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
Cells(AnchorRow, "B").Value = Join(WorksheetFunction.Transpose( _
Cells(AnchorRow, "B").Resize(X - AnchorRow)), " ")
Cells(AnchorRow + 1, "B").Resize(X - AnchorRow - 1).Clear
AnchorRow = X
End If
Next
End Sub

--
Rick (MVP - Excel)



"SteAXA" wrote in message
...
I think that sub resolve what you need:

Sub MergeData()
Dim bEmptyColB As Boolean
Dim bNotEmptyColA As Boolean
Dim nCountRow As Integer
Dim sMergeStr As String

Range("A2").Select

bEmptyColB = False
nCountRow = 0
While Not bEmptyColB
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bEmptyColB = True
Else
bNotEmptyColA = False
sMergeStr = ""
If IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
nCountRow = 0
End If
While Not bNotEmptyColA
If sMergeStr < "" Then
sMergeStr = sMergeStr & " "
End If
sMergeStr = sMergeStr & ActiveCell.Offset(nCountRow,
1).Value
ActiveCell.Offset(nCountRow, 1).Value = ""
nCountRow = nCountRow + 1
If Not IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
Else
If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
bNotEmptyColA = True
ActiveCell.Offset(0, 1).Value = sMergeStr
ActiveCell.Offset(nCountRow, 0).Select
nCountRow = 0
End If
End If
Wend
End If
Wend

End Sub

Bye, Ste'

Merge data by macro
 

Thanks lot friends specially Rick as your code is shorter and works
perfect

Merge data by macro
 

Rick, If you dont mind can you please explain your 2nd macro in detail
that how it works as its just for my understanding. Thanks

Merge data by macro
 

On 13 Mai, 17:03, "Rick Rothstein"
wrote:
Perhaps this is a better way to present my code (using a With/EndWith block
to reduce references)...

Sub CombineData()
* Dim X As Long, LastRow As Long, AnchorRow As Long
* LastRow = Cells(Rows.Count, "B").End(xlUp).Row
* AnchorRow = 2
* For X = AnchorRow + 1 To LastRow + 1
* * If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
* * * With Cells(AnchorRow, "B")
* * * * .Value = Join(Application.Transpose(.Resize(X - AnchorRow)), " ")
* * * * .Offset(1).Resize(X - AnchorRow - 1).Clear
* * * End With
* * * AnchorRow = X
* * End If
* Next
End Sub

--
Rick (MVP - Excel)

"Rick Rothstein" wrote in message

...

This is a lot shorter and should executer quicker...

Sub CombineData()
*Dim X As Long, LastRow As Long, AnchorRow As Long
*LastRow = Cells(Rows.Count, "B").End(xlUp).Row
*AnchorRow = 2
*For X = AnchorRow + 1 To LastRow + 1
* *If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
* * *Cells(AnchorRow, "B").Value = Join(WorksheetFunction.Transpose( _
* * * * * * * * * Cells(AnchorRow, "B").Resize(X - AnchorRow)), " ")
* * *Cells(AnchorRow + 1, "B").Resize(X - AnchorRow - 1).Clear
* * *AnchorRow = X
* *End If
*Next
End Sub

--
Rick (MVP - Excel)

"SteAXA" wrote in message
...
I think that sub resolve what you need:

Sub MergeData()
* *Dim bEmptyColB As Boolean
* *Dim bNotEmptyColA As Boolean
* *Dim nCountRow As Integer
* *Dim sMergeStr As String

* *Range("A2").Select

* *bEmptyColB = False
* *nCountRow = 0
* *While Not bEmptyColB
* * * *If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
* * * * * *bEmptyColB = True
* * * *Else
* * * * * *bNotEmptyColA = False
* * * * * *sMergeStr = ""
* * * * * *If IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
* * * * * * * *bNotEmptyColA = True
* * * * * * * *nCountRow = 0
* * * * * *End If
* * * * * *While Not bNotEmptyColA
* * * * * * * *If sMergeStr < "" Then
* * * * * * * * * *sMergeStr = sMergeStr & " "
* * * * * * * *End If
* * * * * * * *sMergeStr = sMergeStr & ActiveCell.Offset(nCountRow,
1).Value
* * * * * * * *ActiveCell.Offset(nCountRow, 1).Value = ""
* * * * * * * *nCountRow = nCountRow + 1
* * * * * * * *If Not IsEmpty(ActiveCell.Offset(nCountRow, 0)) Then
* * * * * * * * * *bNotEmptyColA = True
* * * * * * * * * *ActiveCell.Offset(0, 1).Value = sMergeStr
* * * * * * * * * *ActiveCell.Offset(nCountRow, 0)..Select
* * * * * * * * * *nCountRow = 0
* * * * * * * *Else
* * * * * * * * * *If IsEmpty(ActiveCell.Offset(nCountRow, 1)) Then
* * * * * * * * * * * *bNotEmptyColA = True
* * * * * * * * * * * *ActiveCell.Offset(0, 1)..Value = sMergeStr
* * * * * * * * * * * *ActiveCell.Offset(nCountRow, 0).Select
* * * * * * * * * * * *nCountRow = 0
* * * * * * * * * *End If
* * * * * * * *End If
* * * * * *Wend
* * * *End If
* *Wend

End Sub

Bye, Ste'

Hello Rick,

Your Sub falls over for two adjacent rows with values in A.

My suggestion to correct for that:
Sub CombineData()
Dim X As Long, LastRow As Long, AnchorRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
AnchorRow = 2
For X = AnchorRow + 1 To LastRow + 1
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
If X - AnchorRow 1 Then
With Cells(AnchorRow, "B")
.Value = Join(Application.Transpose(.Resize(X - AnchorRow)),
" ")
.Offset(1).Resize(X - AnchorRow - 1).Clear
End With
End If
AnchorRow = X
End If
Next
End Sub

Another approach (bottom - up):

Sub CombineData2()
Dim i As Long, lprev As Long
i = Cells(Rows.Count, 2).End(xlUp).Row
lprev = i + 1
Do
If Not IsEmpty(Cells(i, 1)) Then
If lprev - i 1 Then
Cells(i, 2).Formula = Join(Application.Transpose(Cells(i,
2).Resize(lprev - i)), " ")
Cells(i + 1, 2).Resize(lprev - i - 1).ClearContents
End If
lprev = i
End If
i = i - 1
Loop While i 1
End Sub

Regards,
Bernd

Merge data by macro
 

See inline comments...

Your Sub falls over for two adjacent rows with values in A.

My suggestion to correct for that:
Sub CombineData()
Dim X As Long, LastRow As Long, AnchorRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
AnchorRow = 2
For X = AnchorRow + 1 To LastRow + 1
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
If X - AnchorRow 1 Then
With Cells(AnchorRow, "B")
.Value = Join(Application.Transpose(.Resize(X - AnchorRow)),
" ")
.Offset(1).Resize(X - AnchorRow - 1).Clear
End With
End If
AnchorRow = X
End If
Next
End Sub

Good catch Bernd! Your suggested fix is how I would have done it also.


Another approach (bottom - up):

Sub CombineData2()
Dim i As Long, lprev As Long
i = Cells(Rows.Count, 2).End(xlUp).Row
lprev = i + 1
Do
If Not IsEmpty(Cells(i, 1)) Then
If lprev - i 1 Then
Cells(i, 2).Formula = Join(Application.Transpose(Cells(i,
2).Resize(lprev - i)), " ")
Cells(i + 1, 2).Resize(lprev - i - 1).ClearContents
End If
lprev = i
End If
i = i - 1
Loop While i 1
End Sub

I like moving down the column (or left-to-right across the row) whenever
possible... it just seem more natural to me.


--
Rick (MVP - Excel)

Merge data by macro
 

It is a little hard to know the detail I need to go into because I don't
know what parts of the code you already understand and what parts are
causing you to raise the question. However, I tried my best to explain
everything using Comments within the code. Note that I used Bernd's
modification to my originally posted code because he found a condition under
which my original code would fail and provided the appropriate fix for the
problem.

Sub CombineData()
' Always dimension all variables.
Dim X As Long, LastRow As Long, AnchorRow As Long
' Find the last row of data in Column B.
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
' The AnchorRow will be set and reset to the previous cell in
' Column A that had data in it. We do that so we will be able to
' figure out which cells in Column B need to be joined together. We
' start it at the cell in the first row of Column A with data in it.
AnchorRow = 2
' Since we know the first AnchorRow has data in Column A, we start
' our loop from the next row below it. The idea is to keep looping
' until we find the next cell in Column A with data in it. Once we
' find that, we know we must join the Column B cells from the
' AnchorRow to the row before the one we just found.
For X = AnchorRow + 1 To LastRow + 1
' Keep looping until we find a cell in Column A with data in it or
' until we reach the cell after the last piece of data in Column B.
' We need to do this last test because there will not be any data
' in Column A to stop our march downward.
If Cells(X, "A").Value < "" Or X = LastRow + 1 Then
' As Bernd pointed out, we also need to ignore those cases where
' there are two data cells in Column A next to each other...
' there will be no cells in Column B to join in for that case.
' We need this test because the Transpose function will generate
' an error if we try to transpose a single cell.
If X - AnchorRow 1 Then
' The With/End With block is a way to remove redundant object
' calls (whether that object is a range reference or some other
' object such as, for but one example, an ActiveX control. The
' way With/End With works is you put the object itself as the
' argument to the With statement, then you reference it methods
' or properties by using a "dot" in front of it. So, if you had
' Range("A1").Offset(1).Interior.ColorIndex referenced in your
' code, depending on what part of the object chain of property
' calls is repeated in other lines of code (this could be
' Range("A1") or Range("A1").Offset(1) or so on, you would put
' that repeated chain in the With part of the statement and use
' the dotted reference for statements between the With and
' End With statements which, for the above examples would be
' .Offset(1).Interior.ColorIndex or .Interior.ColorIndex and
' so on.
With Cells(AnchorRow, "B")
' Transpose takes a range of adjacent cells in a single column
' and makes it into a one-dimensional array which the VBA Join
' function can do its work on. We use the Resize property to
' expand the range to encompass all the cells from the AnchorRow
' to the row before the cell in Column A that had data in it and
' which cause the code to pass the If tests.
.Value = Join(Application.Transpose(.Resize(X - AnchorRow)), " ")
' We don't want to clear the cell we just put the joined data
' in, so we offset one from the current AnchorRow cell and
' adjust the Resize'd range to be one less... this means we
' reference all the cells we just joined except for the first
' one and Clear them.
.Offset(1).Resize(X - AnchorRow - 1).Clear
End With
End If
' Before we go onto the next iteration of the loop, we update the
' AnchorRow variable and make it equal to the current loop variable
' (which is the row where Column A has data in it).
AnchorRow = X
End If
Next
End Sub

--
Rick (MVP - Excel)



"K" wrote in message
...
Rick, If you dont mind can you please explain your 2nd macro in detail
that how it works as its just for my understanding. Thanks

Merge data by macro
 

thanks a lot for your time and help friends.