PDA

View Full Version : Reply to Closed Thread!



shrivallabha
04-09-2012, 06:37 AM
This thread has been locked.
http://www.vbaexpress.com/forum/showthread.php?p=264594#post264594

So Here is the code for the last request. Red marked part needs to be added.
Sub CombineData()
Dim objDic As Object
Dim sStr As String

Set objDic = CreateObject("Scripting.Dictionary")
objDic.Comparemode = vbTextCompare

'Defining 8 cases
objDic.Add "Scott Clerk 10", 0
objDic.Add "Scott Clerk 20", 0
objDic.Add "Scott 10000 Sales 10", 0
objDic.Add "Scott 10000 Sales 20", 0
objDic.Add "Tiger New York Clerk 10", 0
objDic.Add "Tiger New York Clerk 20", 0
objDic.Add "Tiger Chicago Clerk 10", 0
objDic.Add "Tiger Chicago Clerk 20", 0

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If objDic.exists(Range("B" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) Then
objDic.Item(Range("B" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) = _
objDic.Item(Range("B" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) + _
Range("F" & i).Value
ElseIf objDic.exists(Range("B" & i).Value & " " & Range("C" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) Then
objDic.Item(Range("B" & i).Value & " " & Range("C" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) = _
objDic.Item(Range("B" & i).Value & " " & Range("C" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) + _
Range("F" & i).Value
ElseIf objDic.exists(Range("B" & i).Value & " " & Range("D" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) Then
objDic.Item(Range("B" & i).Value & " " & Range("D" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) = _
objDic.Item(Range("B" & i).Value & " " & Range("D" & i).Value & " " & Range("A" & i).Value & " " & Range("E" & i).Value) + _
Range("F" & i).Value
ElseIf objDic.exists(Range("A" & i).Value & "/" & Range("B" & i).Value & "/" & Range("C" & i).Value _
& "/" & Range("D" & i).Value & "/" & Range("E" & i).Value) Then
objDic.Item(Range("A" & i).Value & "/" & Range("B" & i).Value & "/" & Range("C" & i).Value _
& "/" & Range("D" & i).Value & "/" & Range("E" & i).Value) = objDic.Item(Range("A" & i).Value & "/" & Range("B" & i).Value & "/" & Range("C" & i).Value _
& "/" & Range("D" & i).Value & "/" & Range("E" & i).Value) + Range("F" & i).Value
Else
objDic.Add Range("A" & i).Value & "/" & Range("B" & i).Value & "/" & Range("C" & i).Value _
& "/" & Range("D" & i).Value & "/" & Range("E" & i).Value, Range("F" & i).Value
End If
Next i

With objDic
Range("H2").Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))
End With

With Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row)
.Offset(, 2).Formula = "=CONCATENATE(H2,""="",I2)"
.Value = .Offset(, 2).Value
.Offset(, 1).Resize(, 2).ClearContents
End With

Set objDic = Nothing

End Sub