how to make duplicate value in other column

[SBAY3I]

hi all members
in the link below i put smal exempl for the resultat which i'm looking for, the idea is how to extract duplucate value in other column. by the way the column F and G has a thousands of values
https://1drv.ms/x/s!As8Mdv-a95REhU6iGQZ1-oyfh_Ti










excel version 2007

 

[JLGWhiz]

I don't know which columns are 'From' and which are 'To' but assuming it is From A and B to F and G.
In F2 put

=IF(A2<>"",A2,"")

and in G2 put

=IF(F2<>"",B2,"")

This will then pull the values from A and B column when there is data or will appear blank if there is no data in column A cell. Drag the formulas down as needed.

 

[SBAY3I]

thank you @JLGWhiz for your quike reply. i put your code in cell F2 and G2 as you said but does not work, the columns G and F i put them just to show members where is the duplicate values that's it

 

[Fluff]

@SBAY3I
Please supply the cross Post link. as per Rule#13

 

[SBAY3I]

hi @Fluff
for give me i forgot
​Cross posted https://www.excelforum.com/excel-programming-vba-macros/1245370-how-to-make-duplicate-value-in-other-column.html

 

[SBAY3I]

this thread resolved with this code, i'am very thankful for the member @PCI in www.excelforum.com
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Option Explicit

Sub Treat1()
Dim NomDic As Object
Set NomDic = CreateObject("Scripting.Dictionary")
Dim Rg As Range
Dim K, KK
Dim I As Integer

Application.ScreenUpdating = False
With NomDic
For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)
If (.exists(Rg.Value)) Then
If (.Item(Rg.Value).exists(Rg(1, 0).Value)) Then
.Item(Rg.Value).Item(Rg(1, 0).Value) = .Item(Rg.Value).Item(Rg(1, 0).Value) + 1
Else
.Item(Rg.Value).Item(Rg(1, 0).Value) = 1
End If
Else
Set .Item(Rg.Value) = CreateObject("Scripting.Dictionary")
.Item(Rg.Value).Item(Rg(1, 0).Value) = 1
End If
Next Rg

Range("D2:D" & Cells(Rows.Count, "D").End(3).Row + 1).Resize(, 3).ClearContents
I = 1
For Each K In .keys
For Each KK In .Item(K).keys
If ((.Item(K).Item(KK) <> 1) Or (.Item(K).Count > 1)) Then
I = I + 1
Cells(I, "D") = KK
Cells(I, "E") = K
Cells(I, "F") = .Item(K).Item(KK)
End If
Next KK
If ((.Item(K).Count = 1) And (.Item(K).Item(KK) <> 1)) Then
.Remove (K)
End If
Next K
For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)
Rg.Interior.Pattern = xlNone
If (.exists(Rg.Value)) Then Rg(1, 0).Resize(1, 2).Interior.ColorIndex = 6
Next Rg
End With
Application.ScreenUpdating = True
End Sub

https://www.excelforum.com/excel-programming-vba-macros/1245370-how-to-make-duplicate-value-in-other-column.html#post4973832</code>

 

[SBAY3I]

[COLOR=#333333][FONT=monospace]Option Explicit[/FONT][/COLOR]

[COLOR=#333333][FONT=monospace]Sub Treat1()[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Dim NomDic As Object[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Set NomDic = CreateObject("Scripting.Dictionary")[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Dim Rg As Range[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Dim K, KK[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Dim I As Integer[/FONT][/COLOR]

[COLOR=#333333][FONT=monospace]Application.ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]With NomDic[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If (.exists(Rg.Value)) Then[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If (.Item(Rg.Value).exists(Rg(1, 0).Value)) Then[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace].Item(Rg.Value).Item(Rg(1, 0).Value) = .Item(Rg.Value).Item(Rg(1, 0).Value) + 1[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Else[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace].Item(Rg.Value).Item(Rg(1, 0).Value) = 1[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Else[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Set .Item(Rg.Value) = CreateObject("Scripting.Dictionary")[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace].Item(Rg.Value).Item(Rg(1, 0).Value) = 1[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Next Rg[/FONT][/COLOR]

[COLOR=#333333][FONT=monospace]Range("D2:D" & Cells(Rows.Count, "D").End(3).Row + 1).Resize(, 3).ClearContents[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]I = 1[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]For Each K In .keys[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]For Each KK In .Item(K).keys[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If ((.Item(K).Item(KK) <> 1) Or (.Item(K).Count > 1)) Then[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]I = I + 1[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Cells(I, "D") = KK[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Cells(I, "E") = K[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Cells(I, "F") = .Item(K).Item(KK)[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Next KK[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If ((.Item(K).Count = 1) And (.Item(K).Item(KK) <> 1)) Then[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace].Remove (K)[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Next K[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]For Each Rg In Range("C2:C" & Cells(Rows.Count, "C").End(3).Row)[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Rg.Interior.Pattern = xlNone[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]If (.exists(Rg.Value)) Then Rg(1, 0).Resize(1, 2).Interior.ColorIndex = 6[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Next Rg[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End With[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End Sub[/FONT][/COLOR]