deleting duplicate rows but keeping some data

[bumperjoe]

i know deleting duplicate rows has been done 100x here, but i cannot get it.
if A is duplicated, can you delete the WHOLE row except the contents of B. then add the content of B on the
first occurance of A


A..............................B
FO1101144.... MAZDA/PU 94-97
FO1101144.... MAZDA/PU 98-10
FO1101144.... RANGER 93-97
FO1101144.... RANGER 98-11
to
FO1101144 .... MAZDA/PU 94-97 MAZDAPU98-10 RANGER 93-97 RANGER 98-11

thanks, joe

 

[Tom Urtis]

If your worksheet is set up as you say

and

your data is already sorted by column A as your post suggests

then

this macro is one way to accomplish what you are after:


Sub Test1()
Application.ScreenUpdating = False
Dim xRow&, area As Range, cell As Range
For xRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then _
Rows(xRow).Resize(1).Insert
Next xRow
Columns(1).Insert
For Each area In Columns(2).SpecialCells(2).Areas
With Cells(area.Row, 1)
For Each cell In area.Offset(0, 1).Resize(area.Rows.Count, 1)
.Value = .Value & " " & cell.Value
Next cell
.Value = area.Cells(1, 1).Value & .Value
End With
Next area
Columns(1).SpecialCells(4).EntireRow.Delete
Columns(1).AutoFit
Range(Columns(2), Columns(3)).Delete
Application.ScreenUpdating = True
End Sub

 

[bumperjoe]

it says this line needs debuging ?

Rows(xRow).Resize(1).Insert

If your worksheet is set up as you say

and

your data is already sorted by column A as your post suggests

then

this macro is one way to accomplish what you are after:


Sub Test1()
Application.ScreenUpdating = False
Dim xRow&, area As Range, cell As Range
For xRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then _
Rows(xRow).Resize(1).Insert
Next xRow
Columns(1).Insert
For Each area In Columns(2).SpecialCells(2).Areas
With Cells(area.Row, 1)
For Each cell In area.Offset(0, 1).Resize(area.Rows.Count, 1)
.Value = .Value & " " & cell.Value
Next cell
.Value = area.Cells(1, 1).Value & .Value
End With
Next area
Columns(1).SpecialCells(4).EntireRow.Delete
Columns(1).AutoFit
Range(Columns(2), Columns(3)).Delete
Application.ScreenUpdating = True
End Sub

 

[Tom Urtis]

It all worked when I tested it so something else is going on. Are there any merged cells involved (look closely), and are you sure the original data on the sheet is in column A and column B. Or sis the sheet protected...you did not say what the error number was.

 

[bumperjoe]

should i highlight just A and B or all the columns. i tried it both ways and it just groups the same numbers together with empty rows above and below the groups of duplicate numpers

 

[Tom Urtis]

You don't highlight anything. You just activate the worksheet holding the data and run the macro, which you would place in a standard module.

 

[Tom Urtis]

By the way, I tested the macro using your posted data along with other sample data I created, so I know it works under normal circumstances. Something is happening with your workbook that is causing the error.

 

[bumperjoe]

it says run time error 1004

Application.ScreenUpdating = False
Dim xRow&, area As Range, cell As Range
For xRow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then _
it points to this line .........Rows(xRow).Resize(1).Insert
Next xRow
Columns(1).Insert

 

[Tom Urtis]

• Is the sheet protected.
• Are any rows or columns hidden.
• Are any cells merged.
• Is it really column A and column B that the data resides in.
• I am assuming the data is all constants, no formulas.

The code works with normal data such as you posted. Take a close look at your worksheet to see which item(s) above are causing the error.

 

[Tom Urtis]

Getting used to this new format...tried to delete a duplicate post.