This leaves the rows that will be deleted and adds "Will Be Deleted" in column "K"
then adds the values in the pricing columns so you can see what changes
Sub combineShopsLast3()
Dim x, lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

For x = lr To 2 Step -1
    If Left(Cells(x, 2), 6) = Left(Cells(x - 1, 2), 6) Then
        Select Case Cells(x, "J").Value
            Case "0000"
                Cells(x - 1, "F").Value = Right(Cells(x, 2), 3)
            Case "0004"
                Cells(x - 1, "G").Value = Right(Cells(x, 2), 3)
            Case "5001"
                Cells(x - 1, "H").Value = Right(Cells(x, 2), 3)
        End Select
'cells(x, 2).entirerow.Delete    
Cells(x, "K").Value = "Will be Deleted"
    End If
Next x

End Sub