Condense multiples into first occurrence only

[nguerra]

Is there a way to take the first occurrence in every value change in a column and re-write it with another value in the same row? For example:

Column 1	Column 2			Column 6	Column 7
apple	a			apple	a
apple	a			pear	a
apple	a			orange	b
pear	a			grape	a
pear	a			banana	b
orange	b			apple	b
grape	a			orange	a
grape	a
banana	b
apple	b
apple	b
orange	a

<colgroup><col style="width:54pt" span="6" width="72"> </colgroup><tbody>
</tbody>

 

[nguerra]

Thank you Zax, Seems to be the same problem that Hiker95 had. I'm pasting the out put below(section of real data). A&B are the original, F&G are your output, and J&K is whats needed.

Part	Sub Part				Part	Sub Part			Part	Sub Part
NS1050F1013	PAT				NS1050F1013	PAT			NS1050F1013	PAT
NS11086B510	Q				NS11086B510	Q			NS11086B510	Q
NS11086B510	Q				NS11086B510	DFC			NS1134F1169	DFC
NS11086B510	Q				NS11086B510	Q			NS1144F0848	DFC
NS11086B510	DFC				NS11086B510	PAT			NS1145F0950	Q
NS11086B510	Q				NS1134F1169	DFC			NS1146F0931	DFC
NS11086B510	Q				NS1134F1169	PAT			NS1203F0196	PAT
NS11086B510	PAT				NS1144F0848	DFC			NS12076A583	Q
NS1134F1169	DFC				NS1144F0848	PAT
NS1134F1169	PAT				NS1145F0950	Q
NS1144F0848	DFC				NS1145F0950	DFC
NS1144F0848	PAT				NS1145F0950	PAT
NS1145F0950	Q				NS1146F0931	DFC
NS1145F0950	DFC				NS1146F0931	Q
NS1145F0950	PAT				NS1146F0931	DFC
NS1146F0931	DFC				NS1146F0931	PAT
NS1146F0931	Q				NS1203F0196	PAT
NS1146F0931	DFC				NS12076A583	Q
NS1146F0931	PAT				NS12076A583	DFC
NS1203F0196	PAT				NS12076A583	Q
NS12076A583	Q				NS12076A583	PAT
NS12076A583	DFC				NS1233F0408	MC

<colgroup><col><col><col span="3"><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

 

[nguerra]

Sorry Zax, I posted your results, trying everyone's but I'm still getting duplicates from everyone.

 

[ZAX]

Thank you Zax, Seems to be the same problem that Hiker95 had. I'm pasting the out put below(section of real data). A&B are the original, F&G are your output, and J&K is whats needed.

Part	Sub Part				Part	Sub Part			Part	Sub Part
NS1050F1013	PAT				NS1050F1013	PAT			NS1050F1013	PAT
NS11086B510	Q				NS11086B510	Q			NS11086B510	Q
NS11086B510	Q				NS11086B510	DFC			NS1134F1169	DFC
NS11086B510	Q				NS11086B510	Q			NS1144F0848	DFC
NS11086B510	DFC				NS11086B510	PAT			NS1145F0950	Q
NS11086B510	Q				NS1134F1169	DFC			NS1146F0931	DFC
NS11086B510	Q				NS1134F1169	PAT			NS1203F0196	PAT
NS11086B510	PAT				NS1144F0848	DFC			NS12076A583	Q
NS1134F1169	DFC				NS1144F0848	PAT
NS1134F1169	PAT				NS1145F0950	Q
NS1144F0848	DFC				NS1145F0950	DFC
NS1144F0848	PAT				NS1145F0950	PAT
NS1145F0950	Q				NS1146F0931	DFC
NS1145F0950	DFC				NS1146F0931	Q
NS1145F0950	PAT				NS1146F0931	DFC
NS1146F0931	DFC				NS1146F0931	PAT
NS1146F0931	Q				NS1203F0196	PAT
NS1146F0931	DFC				NS12076A583	Q
NS1146F0931	PAT				NS12076A583	DFC
NS1203F0196	PAT				NS12076A583	Q
NS12076A583	Q				NS12076A583	PAT
NS12076A583	DFC				NS1233F0408	MC

<colgroup><col><col><col span="3"><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

So you want the out put to be in J & K? and which range will the code examine?

 

[nguerra]

Output can go anywhere and the original code is in columns A&B. When I ran your code, I got the output in columns F&G. When I looked at column F, I still saw more than one instance. The output should look like J&K but again, it can go into any column.

 

[ZAX]

Output can go anywhere and the original code is in columns A&B. When I ran your code, I got the output in columns F&G. When I looked at column F, I still saw more than one instance. The output should look like J&K but again, it can go into any column.

I tried it, how's that possible? try this, it will clear columns F&G then insert the summary:

Sub CopyOneInstance()
Dim Cell As Range
Range("F2:G" & Cells(Rows.Count, 6).End(xlUp).Row).Clear
For Each Cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If Cell.Value <> Cell.Offset(1, 0).Value Or Cell.Offset(0, 1).Value <> Cell.Offset(1, 1).Value Then
        Range(Cells(Cell.Row, Cell.Column), Cells(Cell.Row, 2)).Copy Range(Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 6), _
        Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 7))
    End If
Next
Application.CutCopyMode = False
End Sub

I tried the code and it works every time!
ZAX

 

[hiker95]

nguerra,

It is always best to display your actual raw data, and, the results that you are looking for. This way we can usually find a solution on the first go.

Sample raw data in columns A, and, B:

Excel 2007
	A	B	C	D	E	F	G
1	Part	Sub Part
2	NS1050F1013	PAT
3	NS11086B510	Q
4	NS11086B510	Q
5	NS11086B510	Q
6	NS11086B510	DFC
7	NS11086B510	Q
8	NS11086B510	Q
9	NS11086B510	PAT
10	NS1134F1169	DFC
11	NS1134F1169	PAT
12	NS1144F0848	DFC
13	NS1144F0848	PAT
14	NS1145F0950	Q
15	NS1145F0950	DFC
16	NS1145F0950	PAT
17	NS1146F0931	DFC
18	NS1146F0931	Q
19	NS1146F0931	DFC
20	NS1146F0931	PAT
21	NS1203F0196	PAT
22	NS12076A583	Q
23	NS12076A583	DFC
24
Sheet1

After the new macro in columns F, and, G:

Excel 2007
	A	B	C	D	E	F	G
1	Part	Sub Part				Part	Sub Part
2	NS1050F1013	PAT				NS1050F1013	PAT
3	NS11086B510	Q				NS11086B510	Q
4	NS11086B510	Q				NS1134F1169	DFC
5	NS11086B510	Q				NS1144F0848	DFC
6	NS11086B510	DFC				NS1145F0950	Q
7	NS11086B510	Q				NS1146F0931	DFC
8	NS11086B510	Q				NS1203F0196	PAT
9	NS11086B510	PAT				NS12076A583	Q
10	NS1134F1169	DFC
11	NS1134F1169	PAT
12	NS1144F0848	DFC
13	NS1144F0848	PAT
14	NS1145F0950	Q
15	NS1145F0950	DFC
16	NS1145F0950	PAT
17	NS1146F0931	DFC
18	NS1146F0931	Q
19	NS1146F0931	DFC
20	NS1146F0931	PAT
21	NS1203F0196	PAT
22	NS12076A583	Q
23	NS12076A583	DFC
24
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetFirstPairs()
' hiker95, 02/19/2014, ME758897
Dim r As Long, lr As Long, n As Long, nr As Long
Application.ScreenUpdating = False
Columns("F:G").ClearContents
Cells(1, 6).Resize(, 2).Value = Cells(1, 1).Resize(, 2).Value
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
  nr = Range("F" & Rows.Count).End(xlUp).Offset(1).Row
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  If n = 1 Then
    Cells(nr, 6).Resize(, 2).Value = Cells(r, 1).Resize(, 2).Value
  ElseIf n > 1 Then
    Cells(nr, 6).Resize(, 2).Value = Cells(r, 1).Resize(, 2).Value
  End If
  r = r + n - 1
Next r
Columns("F:G").AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetFirstPairs macro.

 

[Marcelo Branco]

Maybe...

Sub FirstOnly()
    Dim lastRow As Long, i As Long
    
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    With CreateObject("Scripting.Dictionary")
        .comparemode = vbTextCompare
        
        For i = 1 To lastRow
            If Not .exists(Cells(i, 1).Value) Then .Add Cells(i, 1).Value, Cells(i, 2).Value
        Next i
        
        Range("F1").Resize(.Count).Value = Application.Transpose(.keys)
        Range("G1").Resize(.Count).Value = Application.Transpose(.items)
    End With
End Sub

M.

 

[nguerra]

nguerra,

It is always best to display your actual raw data, and, the results that you are looking for. This way we can usually find a solution on the first go.

Sample raw data in columns A, and, B:

Excel 2007

	A	B	C	D	E	F	G
1	Part	Sub Part
2	NS1050F1013	PAT
3	NS11086B510	Q
4	NS11086B510	Q
5	NS11086B510	Q
6	NS11086B510	DFC
7	NS11086B510	Q
8	NS11086B510	Q
9	NS11086B510	PAT
10	NS1134F1169	DFC
11	NS1134F1169	PAT
12	NS1144F0848	DFC
13	NS1144F0848	PAT
14	NS1145F0950	Q
15	NS1145F0950	DFC
16	NS1145F0950	PAT
17	NS1146F0931	DFC
18	NS1146F0931	Q
19	NS1146F0931	DFC
20	NS1146F0931	PAT
21	NS1203F0196	PAT
22	NS12076A583	Q
23	NS12076A583	DFC
24

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

After the new macro in columns F, and, G:

Excel 2007

	A	B	C	D	E	F	G
1	Part	Sub Part				Part	Sub Part
2	NS1050F1013	PAT				NS1050F1013	PAT
3	NS11086B510	Q				NS11086B510	Q
4	NS11086B510	Q				NS1134F1169	DFC
5	NS11086B510	Q				NS1144F0848	DFC
6	NS11086B510	DFC				NS1145F0950	Q
7	NS11086B510	Q				NS1146F0931	DFC
8	NS11086B510	Q				NS1203F0196	PAT
9	NS11086B510	PAT				NS12076A583	Q
10	NS1134F1169	DFC
11	NS1134F1169	PAT
12	NS1144F0848	DFC
13	NS1144F0848	PAT
14	NS1145F0950	Q
15	NS1145F0950	DFC
16	NS1145F0950	PAT
17	NS1146F0931	DFC
18	NS1146F0931	Q
19	NS1146F0931	DFC
20	NS1146F0931	PAT
21	NS1203F0196	PAT
22	NS12076A583	Q
23	NS12076A583	DFC
24

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub GetFirstPairs()
' hiker95, 02/19/2014, ME758897
Dim r As Long, lr As Long, n As Long, nr As Long
Application.ScreenUpdating = False
Columns("F:G").ClearContents
Cells(1, 6).Resize(, 2).Value = Cells(1, 1).Resize(, 2).Value
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
  nr = Range("F" & Rows.Count).End(xlUp).Offset(1).Row
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  If n = 1 Then
    Cells(nr, 6).Resize(, 2).Value = Cells(r, 1).Resize(, 2).Value
  ElseIf n > 1 Then
    Cells(nr, 6).Resize(, 2).Value = Cells(r, 1).Resize(, 2).Value
  End If
  r = r + n - 1
Next r
Columns("F:G").AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetFirstPairs macro.

Hiker95,

This worked great and executes very fast. Looks like the values are very close to what I was expecting. If i wanted to add an additional column (c) and have that column be copied over with the other two, what would need to change in the vba code?

 

[hiker95]

nguerra,

Please do not quote entire replies from your helper. When quoting follow these guidelines:
1. Quote ONLY if it is needed to add clarity or context for your reply. If so, then
2. Quote ONLY the specific part of the post that is relevant - - not the entire post.

This will keep thread clutter to a minimum and make the discussion easier to follow.

And, when you respond to your helper, please use their site ID/username/handle.


Thanks for the feedback.

You are very welcome. Glad I could help.

Looks like the values are very close to what I was expecting. If i wanted to add an additional column (c) and have that column be copied over with the other two, what would need to change in the vba code?

In order to continue please supply screenshots of before and after:

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker

Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.
See reply #2 the BLUE text in the following link:
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[nguerra]

Marco, Yes your code below works better now

Sub FirstOnly()

Dim lastRow As Long, i As Long

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

With CreateObject("Scripting.Dictionary")
.comparemode = vbTextCompare

For i = 1 To lastRow
If Not .exists(Cells(i, 1).Value) Then .Add Cells(i, 1).Value, Cells(i, 2).Value
Next i

Range("F1").Resize(.Count).Value = Application.Transpose(.keys)
Range("G1").Resize(.Count).Value = Application.Transpose(.items)

End With

End Sub



I found out though that I need to add another column and I'd like to have that column copied over just like the second column was. So now you would check the first cell and if different from the previous, copy over that cell and the next two cells.

a	b	c	d	e	f	g	h
NS1050F1013	PAT	Key			NS1050F1013	PAT	Key
NS11086B510	Q	Key			NS11086B510	Q	Key
NS11086B510	Q	Key			NS1134F1169	DFC	Key
NS11086B510	Q	Key
NS11086B510	DFC	Key
NS11086B510	Q	Key
NS11086B510	Q	Key
NS11086B510	PAT	Key
NS1134F1169	DFC	Key
NS1134F1169	PAT	Key
NS1144F0848	DFC	Key
NS1144F0848	PAT	Key
NS1145F0950	Q	Key
NS1145F0950	DFC	Key
NS1145F0950	PAT	Key
NS1146F0931	DFC	Key
NS1146F0931	Q	Key
NS1146F0931	DFC	Key
NS1146F0931	PAT	Key
NS1203F0196	PAT	Key
NS12076A583	Q	Key
NS12076A583	DFC	Key
NS12076A583	Q	Key
NS12076A583	PAT	Key
NS1233F0408	MC	Key
NS1233F0408	MC	Key
NS1233F0408	Q	Key
NS1233F0408	DFC	Key
NS1233F0408	PAT	Key
NS103562775	PAT	Key
NS1119F0564	Q	Key
NS1119F0564	DFC	Key
NS1119F0564	Q	Key
NS1119F0564	Q	Key
NS1119F0564	PAT	Key
NS1147F1664	PAT	Key
NS1150F0976	Q	Key
NS1150F0976	DFC	Key

<tbody>
</tbody>