Macro to delete duplicate cell

[PointerMan]

I have a large spreadsheet that I need to clean up. My data is kept by row,
so some rows have the same information in two adjacent cells. An example is
below in rows 2 through 5.

1 DB A HF SR SCR PI
2 SAW DB SR DR DB DB
3 SAW DB SR DR DB DB
4 SAW DB SR DR DB DB
5 SAW DB SR DR DB DB

Is there a macro that can automatically delete the 2nd duplicate cell
entirely so that the remaining cells will shift to the left? I can delete
them manually one at a time and shift the remaining cells left, but I'd like
to be able to clean up the entire sheet at once.

 

[Jacob Skaria]

Hi Greetings!!

Please try the below code to clean up consecutive duplicate rows. Please
adjust the Function incase you have more number of columns.

Dim intRow
Dim strData

intRow = 2

Do while Range("A" & intRow) <> ""

If GetRowDatatoString(intRow-1) = GetRowDatatoString(intRow) Then
Rows(intRow).Entirerow.Delete
intRow = intRow -1
End If

intRow = intRow + 1
Loop

Function GetRowDatatoString(intRow)
GetRowDatatoString = Range("A" & intRow) & Range("B" & intRow) & Range("C"
& intRow) & Range("D" & intRow) & Range("E" & intRow)
End Function