Hi Mandeep,

Am Thu, 3 Dec 2015 03:35:34 -0800 (PST) schrieb Mandeep Baluja:

Each unique Entries and their corresponding values should get concatenate with uniqueness,Attached macro working correctly but not efficient,I need some suggestion to avoid the Multiple if checks and , Is it possible to create dictionary objects with loops. I want to automate this too.

why don't you create a key over the 4 columns?

Try:

Sub Test()
Dim varData As Variant, varOut() As Variant
Dim i As Long, j As Long
Dim myDic As Object
Dim key As String, myStr As String

With Sheets("Sheet1")
If myDic Is Nothing Then
Set myDic = CreateObject("Scripting.Dictionary")
varData = .Range("A1:D1085")
For i = LBound(varData) To UBound(varData)
key = varData(i, 1) & "," & varData(i, 2) & "," _
& varData(i, 3) & "," & varData(i, 4)
If Not myDic.Exists(key) Then
myDic(key) = i
ReDim Preserve varOut(j)
varOut(j) = key
j = j + 1
End If
Next
End If
End With

With Sheets("Sheet2")
For i = LBound(varOut) To UBound(varOut)
.Cells(i + 1, 1).Resize(1, 4) = Split(varOut(i), ",")
Next
End With
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional