Creating a list of unique data involving 2 columns... VBA

D

Darth_Sullivan

New Member
Joined
Oct 23, 2013
Messages
48
I've seen posts about copying and pasting data filtered for uniques before. I found one that does almost exactly what I need it to do. Current code searches all my sheets through column A for all unique values and presents them to me on the sheet with my command button. What I need it tweaked for, is i need it to bring the contents of column B that corresponds to the unique number from A.

More simply stated: Column A across many different sheets contains a customer ID number unique to them.

Column B contains their name.

Each row represents a transaction with said customer.

I am trying to create a sheet that will show each customer with their name to essentially have just a directory of names and ID numbers.

Current code just brings and sorts my ID numbers...
Code: 
Sub UniqueValues()

Dim newWS As Worksheet, r As Long, N As Long, i As Integer

Application.ScreenUpdating = False

    N = 1
        For i = 2 To Sheets.Count - 2
            r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row
            Sheets(i).Range("A2:A" & r).Copy
            Cells(N, 1).PasteSpecial xlValues
            N = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Next
    r = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A2:A" & r).AdvancedFilter _
    Action:=xlFilterInPlace, Unique:=True
    Range("A2:A" & r).Copy
    Range("B2").PasteSpecial xlValues
    Application.CutCopyMode = False
    Range("A2:A" & r).AdvancedFilter _
    Action:=xlFilterInPlace, Unique:=False
    Columns(1).Delete
    r = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A2:A" & r).Sort key1:=Range("A2"), header:=xlNo
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton1_Click()

Sheets("Players").UniqueValues

End Sub

Any help is much appreciated. I've just simply been unable to decipher what I need to tell vba to do...

Thank you for your time.
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Darth_Sullivan,

What version of Excel and Windows are you using?

Are you using a PC or a Mac?

Can you post screenshots of at least two of the actual raw data worksheets?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

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.
 
Upvote 0
Now that I figured out how to:

Sheet 1 sample
IDNameStartFinishHoursDayPoints Earned
14322John Smith1/2/2014 16:401/2/2014 17:380.9751.94
14322John Smith1/4/2014 19:331/4/2014 20:431.1773.51
36197Juan Valdez1/12/2014 20:081/12/2014 22:172.1512.15
38332Ricky Bobby1/24/2014 17:571/24/2014 20:102.2162.21
48675Corey Haim1/9/2014 17:461/9/2014 19:281.6853.36
48675Corey Haim1/17/2014 18:511/17/2014 19:390.860.8
4878Richard Petty1/19/2014 18:061/19/2014 20:392.5412.54
49160Larry Lobster1/19/2014 17:581/19/2014 20:342.5912.59
63169Don Quixote1/6/2014 20:221/6/2014 22:151.8821.88
63169Don Quixote1/19/2014 18:111/19/2014 19:141.0511.05
12219Tom Turtle1/11/2014 20:571/11/2014 23:532.9478.82
50607Jimmy Fallon1/9/2014 16:271/9/2014 19:283.0256.04

<COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 71pt; mso-width-source: userset; mso-width-alt: 3474" width=95><COL style="WIDTH: 76pt; mso-width-source: userset; mso-width-alt: 3693" span=2 width=101><COL style="WIDTH: 48pt" span=2 width=64><COL style="WIDTH: 67pt; mso-width-source: userset; mso-width-alt: 3254" width=89><TBODY>
</TBODY>


Sheet 2 sample:
IDNameStartFinishHoursDayPoints Earned
12219Tom Turtle2/21/2014 20:512/21/2014 21:230.5460.54
36197Juan Valdez2/1/2014 20:412/1/2014 23:312.8378.49
57913Taylor Swift2/1/2014 17:402/1/2014 19:452.0876.24
57913Taylor Swift2/7/2014 22:372/7/2014 23:220.7560.75
4878Richard Petty2/16/2014 17:562/16/2014 19:271.5111.51
30281Randy Johns2/24/2014 20:052/24/2014 21:371.5221.52
63169Don Quixote2/6/2014 21:382/6/2014 22:360.9651.92
63169Don Quixote2/8/2014 17:062/8/2014 19:212.2676.78
56800Tim Robbins2/23/2014 18:262/23/2014 21:443.2913.29
56801Rob Ford2/23/2014 18:262/23/2014 21:443.2913.29
11591Barack Obama2/9/2014 18:152/9/2014 18:460.5110.51
11591Barack Obama2/21/2014 18:052/21/2014 19:171.261.2

<COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 71pt; mso-width-source: userset; mso-width-alt: 3474" width=95><COL style="WIDTH: 76pt; mso-width-source: userset; mso-width-alt: 3693" span=2 width=101><COL style="WIDTH: 48pt" span=2 width=64><COL style="WIDTH: 67pt; mso-width-source: userset; mso-width-alt: 3254" width=89><TBODY>
</TBODY>

Expected outcome:
IDName
4878Richard Petty
11591Barack Obama
12219Tom Turtle
14322John Smith
30281Randy Johns
36197Juan Valdez
38332Ricky Bobby
48675Corey Haim
49160Larry Lobster
50607Jimmy Fallon
56800Tim Robbins
56801Rob Ford
57913Taylor Swift
63169Don Quixote

<COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 71pt; mso-width-source: userset; mso-width-alt: 3474" width=95><TBODY>
</TBODY>


List of unique ID numbers with their names. I will then later be using this list to show different totals based on the raw data, which is the only reason I included it in the post. Again, the code I posted in the original post works but only brings over and sorts the ID numbers and does not bring the names.

Thank you for your time.
 
Upvote 0
Darth_Sullivan,

Thanks for the screenshots.

Sample worksheets:


Excel 2007
ABCDEFG
1IDNameStartFinishHoursDayPoints Earned
214322John Smith1/2/2014 16:401/2/2014 17:380.9751.94
314322John Smith1/4/2014 19:331/4/2014 20:431.1773.51
436197Juan Valdez1/12/2014 20:081/12/2014 22:172.1512.15
538332Ricky Bobby1/24/2014 17:571/24/2014 20:102.2162.21
648675Corey Haim1/9/2014 17:461/9/2014 19:281.6853.36
748675Corey Haim1/17/2014 18:511/17/2014 19:390.860.8
84878Richard Petty1/19/2014 18:061/19/2014 20:392.5412.54
949160Larry Lobster1/19/2014 17:581/19/2014 20:342.5912.59
1063169Don Quixote1/6/2014 20:221/6/2014 22:151.8821.88
1163169Don Quixote1/19/2014 18:111/19/2014 19:141.0511.05
1212219Tom Turtle1/11/2014 20:571/11/2014 23:532.9478.82
1350607Jimmy Fallon1/9/2014 16:271/9/2014 19:283.0256.04
14
Sheet1



Excel 2007
ABCDEFG
1IDNameStartFinishHoursDayPoints Earned
212219Tom Turtle2/21/2014 20:512/21/2014 21:230.5460.54
336197Juan Valdez2/1/2014 20:412/1/2014 23:312.8378.49
457913Taylor Swift2/1/2014 17:402/1/2014 19:452.0876.24
557913Taylor Swift2/7/2014 22:372/7/2014 23:220.7560.75
64878Richard Petty2/16/2014 17:562/16/2014 19:271.5111.51
730281Randy Johns2/24/2014 20:052/24/2014 21:371.5221.52
863169Don Quixote2/6/2014 21:382/6/2014 22:360.9651.92
963169Don Quixote2/8/2014 17:062/8/2014 19:212.2676.78
1056800Tim Robbins2/23/2014 18:262/23/2014 21:443.2913.29
1156801Rob Ford2/23/2014 18:262/23/2014 21:443.2913.29
1211591Barack Obama2/9/2014 18:152/9/2014 18:460.5110.51
1311591Barack Obama2/21/2014 18:052/21/2014 19:171.261.2
14
Sheet2


After the macro in a new worksheet Results:


Excel 2007
AB
1IDName
24878Richard Petty
311591Barack Obama
412219Tom Turtle
514322John Smith
630281Randy Johns
736197Juan Valdez
838332Ricky Bobby
948675Corey Haim
1049160Larry Lobster
1150607Jimmy Fallon
1256800Tim Robbins
1356801Rob Ford
1457913Taylor Swift
1563169Don Quixote
16
Results


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).

Code: 
Option Explicit
Sub GetUniqueIDsNames()
' hiker95, 03/07/2014, ME762149
Dim c As Range, rng As Range, n As Long
Dim ws As Worksheet, wR As Worksheet
Application.ScreenUpdating = False
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wR = Sheets("Results")
With Sheets("Results")
  .UsedRange.ClearContents
  .Range("A1").Resize(, 2).Value = Array("ID", "Name")
End With
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Results" Then
      Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & Rows.Count).End(xlUp))
      For Each c In rng
        If Not .Exists(c.Value) Then
          .Add c.Value, 1
          .Item(c.Value) = c.Offset(, 1).Value
        End If
      Next c
    End If
  Next ws
  n = .Count
  wR.Range("A2").Resize(n, 2) = Application.Transpose(Array(.Keys, .Items))
  wR.Range("A2:B" & n + 1).Sort key1:=wR.Range("A2"), order1:=1
End With
With Sheets("Results")
  .Columns("A:B").AutoFit
  .Activate
End With
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 GetUniqueIDsNames macro.
 
Upvote 0
Code: 
Option Explicit
Sub GetUniqueIDsNames()
' hiker95, 03/07/2014, ME762149
Dim c As Range, rng As Range, n As Long
Dim ws As Worksheet, wR As Worksheet
Application.ScreenUpdating = False
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wR = Sheets("Results")
With Sheets("Results")
  .UsedRange.ClearContents
  .Range("A1").Resize(, 2).Value = Array("ID", "Name")
End With
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Results" Then
      Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & Rows.Count).End(xlUp))
      For Each c In rng
        If Not .Exists(c.Value) Then
          .Add c.Value, 1
          .Item(c.Value) = c.Offset(, 1).Value
        End If
      Next c
    End If
  Next ws
  n = .Count
  wR.Range("A2").Resize(n, 2) = Application.Transpose(Array(.Keys, .Items))
  wR.Range("A2:B" & n + 1).Sort key1:=wR.Range("A2"), order1:=1
End With
With Sheets("Results")
  .Columns("A:B").AutoFit
  .Activate
End With
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 GetUniqueIDsNames macro.
Click to expand...

This works but I'm having trouble now applying it into my actual workbook. I'm trying to having this code only pull the names from 12 different sheets, each named a month January, February, etc. As I am clearly not well versed in coding, my efforts to adapt this code to instead of determining if the sheet <> "Results" to if the sheet is named one of the months of the year...

In other words, there are other sheets in the workbook that I don't want included in the pull for unique data...

Thank you again for your time.
 
Upvote 0
Darth_Sullivan,

This works but I'm having trouble now applying it into my actual workbook.
Click to expand...

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

So that I can get it right this next time, please list the actual worksheet names (correct spelling) that you want the macro to run in?
 
Upvote 0
Darth_Sullivan,

Please check the spelling of the months in the wsary in the macro.

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).

Code: 
Option Explicit
Sub GetUniqueIDsNamesV2()
' hiker95, 03/11/2014, ME762149
Dim c As Range, rng As Range, n As Long
Dim ws As Worksheet, wR As Worksheet
Dim wsary, i As Long
Application.ScreenUpdating = False
wsary = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wR = Sheets("Results")
With Sheets("Results")
  .UsedRange.ClearContents
  .Range("A1").Resize(, 2).Value = Array("ID", "Name")
End With
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For i = LBound(wsary) To UBound(wsary)
    Set ws = Sheets(wsary(i))
    Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & Rows.Count).End(xlUp))
    For Each c In rng
      If Not .Exists(c.Value) Then
        .Add c.Value, 1
        .Item(c.Value) = c.Offset(, 1).Value
      End If
    Next c
  Next i
  n = .Count
  wR.Range("A2").Resize(n, 2) = Application.Transpose(Array(.Keys, .Items))
  wR.Range("A2:B" & n + 1).Sort key1:=wR.Range("A2"), order1:=1
End With
With Sheets("Results")
  .Columns("A:B").AutoFit
  .Activate
End With
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 GetUniqueIDsNamesV2 macro.
 
Upvote 0
hiker95 said:
Darth_Sullivan,



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

So that I can get it right this next time, please list the actual worksheet names (correct spelling) that you want the macro to run in?
Click to expand...

Terribly sorry, my data given was raw data, just didn't mention the rest of the sheets in the workbook. Noted for future reference.

Code: 
Option Explicit
Sub GetUniqueIDsNamesV2()
' hiker95, 03/11/2014, ME762149
Dim c As Range, rng As Range, n As Long
Dim ws As Worksheet, wR As Worksheet
Dim wsary, i As Long
Application.ScreenUpdating = False
wsary = Array("January", "February", "March", "April", "May", "June",  "July", "August", "September", "October", "November", "December")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add().Name = "Results"
Set wR = Sheets("Results")
With Sheets("Results")
  .UsedRange.ClearContents
  .Range("A1").Resize(, 2).Value = Array("ID", "Name")
End With
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For i = LBound(wsary) To UBound(wsary)
    Set ws = Sheets(wsary(i))
    Set rng = ws.Range(ws.Range("A2"), ws.Range("A" & Rows.Count).End(xlUp))
    For Each c In rng
      If Not .Exists(c.Value) Then
        .Add c.Value, 1
        .Item(c.Value) = c.Offset(, 1).Value
      End If
    Next c
  Next i
  n = .Count
  wR.Range("A2").Resize(n, 2) = Application.Transpose(Array(.Keys, .Items))
  wR.Range("A2:B" & n + 1).Sort key1:=wR.Range("A2"), order1:=1
End With
With Sheets("Results")
  .Columns("A:B").AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub
Click to expand...

This works completely perfect, thank you immensely!

Code: 
For i = LBound(wsary) To UBound(wsary)
    Set ws = Sheets(wsary(i))

This is what I was missing when I tried to solve myself, thank you again.
 
Upvote 0
Darth_Sullivan,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Multiple filters on filtered list
Replies
1
Views
293
Cubist
Cubist
R
  • Question
Extract rows based upon unique data in first column of an array
Replies
2
Views
244
RJC40
R
K
  • Solved
My VBA is only copying the last row of data instead of all the rows
2 3
Replies
24
Views
684
Alex Blakenburg
A
M
  • Solved
Add new sheet per unique value in column A and copy data (along with header) to respective new sheets
Replies
7
Views
526
Alex Blakenburg
A
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
416
Alex Blakenburg
A

Forum statistics

Threads
1,216,077
Messages
6,128,685
Members
449,463
Latest member
Jojomen56

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top