Solved: Merge and Delete duplicate in 2 column

[parscon]

I need macro to check 2 column and check 2 column A and B if the are same delete but if ther are nir same merge them .

Column A---------Column B

BOM12345------- BOM12347

BOM12345------- BOM12347

BOM12345------- BOM12346

When run Macro it will be

BOM12345------- BOM12347-BOM12346


Please help me for this . Thank ou for all of you that help .

[Bob Phillips]

Sub ProcesData()
Dim lastrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow - 1 To 1 Step -1

If .Cells(i, "A").Value = .Cells(i + 1, "A").Value Then

If .Cells(i, "B").Value = .Cells(i + 1, "B").Value Then

.Rows(i).Delete
Else

.Cells(i, "C").Value = .Cells(i, "B").Value & "-" & .Cells(i + 1, "B").Value
.Rows(i + 1).Delete
End If
End If
Next i

.Columns(2).Delete
End With

Application.ScreenUpdating = True
End Sub

[parscon]

Thank you but it is not work , please check the attachment .

in excel file i have these data :

Column A Column B
VOE11117464 A30E (Volvo)
VOE11117464 A30E (Volvo)
VOE11117509 A30E (Volvo)
VOE11117507 A40E (Volvo)
VOE11117507 A41E (Volvo)


but when run your macro code delete all data on B colum . the items have not duplicate data on column B

I need this :
Column A Column B
VOE11117464 A30E (Volvo)
VOE11117509 A30E (Volvo)
VOE11117507 A40E (Volvo)- A41E (Volvo)

[lncrj017]

This is what you need parscon.. the macro start from row 2 so pretend that you have header

Option Explicit
Sub Merging_Duplicate()

Dim a, i As Long, ii As Long, n As Long, z As String, x As Long
a = Sheets("Sheet1").Range("a1").CurrentRegion.Value
n = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
For ii = 1 To 1
z = z & Chr(2) & a(i, ii)
Next
If Not .exists(z) Then
n = n + 1: .Item(z) = n
For ii = 1 To UBound(a, 2)
a(n, ii) = a(i, ii)
Next
Else
x = .Item(z)
For ii = 2 To UBound(a, 2)
If a(i, ii) <> "" Then
a(x, ii) = a(x, ii) & IIf(a(x, ii) <> "", ", ", "") & a(i, ii)
End If
Next
End If
z = ""
Next
End With
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Results").Delete
On Error GoTo 0
Sheets.Add().Name = "Results"
With Sheets("Results").Cells(1).Resize(n, UBound(a, 2))
.Value = a


End With
End Sub

[parscon]

Thank you for your help