Seperate Repeating Info into One Line while deleting others
Try this
Sub Test()
Dim myCell As Range
Dim aWS As Worksheet
Dim lRow As Long
Dim myDeleteRange As Range
Set aWS = ActiveSheet
lRow = aWS.Cells(aWS.Rows.Count, 1).End(xlUp).row
Set myCell = aWS.Range("A1") '<~~~change first cell as needed
Do
If myCell.Offset(1, 0).Value = myCell.Value Then
lcol = aWS.Cells(myCell.row, aWS.Columns.Count).End(xlToLeft).Column
+ 1
myCell.Offset(0, lcol - myCell.Column).Value = myCell.Offset(1,
1).Value
If myDeleteRange Is Nothing Then
Set myDeleteRange = myCell.Offset(1, 0)
Else
Set myDeleteRange = Union(myDeleteRange, myCell.Offset(1, 0))
End If
End If
Set myCell = myCell.Offset(1, 0)
Loop While myCell.row < lRow
If Not myDeleteRange Is Nothing Then
Debug.Print myDeleteRange.Address
myDeleteRange.EntireRow.Delete
End If
End Sub
--
HTH,
Barb Reinhardt
If this post was helpful to you, please click YES below.
" wrote:
Hi -
I'm trying to seperate out repeating info (last column has unique
data) and place them into a new line.
For example:
12345 CBB
12345 GGG
54321 PPP
99999 BBB
99999 AXZ
Would turn into
12345 CBB GGG
54321 PPP
99999 BBB AXZ
I've been trying to do this through a macro by reading in every row
and matching if the first column matches the second column then take
whats in the first column and place into the last column then delete
the first row.
But I havn't found a great way in code to do this yet. My first
problem is that I can't determine how many times the number would
repeat so I don't know how many columns to go over etc...
Thanks for any help on this,
- Tek
|