Help counting and copying unique values.

joe97281

New Member
Joined
Feb 28, 2018
Messages
5
I am trying to make a macro that will take take information from a column in sheet1, and create multiple columns in sheet2 with the unique values as titles.

Ex: Sheet 1 Column a contains values of: Dog, Cat, Dog, Pony...

I need Sheet 2 to have 3 columns titled for each unique value (Dog, Cat, Pony...)

Any help in appreciated, as all my attempts have failed.
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Hi & welcome to MrExcel
How about
Code:
Sub CreateTitles()

   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
      Next Cl
      Sheets("Sheet2").Range("A1").Resize(, .Count) = .keys
   End With
End Sub
 
Upvote 0
Thanks Fluff, worked like a charm!

I am trying to test it out and see what the count of the unique number of items is, this will help me understand the functions and arguments. What will allow me to display in a cell (C1 in this case) what the count was?

Range("C1").Value = XX?

This is only part of what I need to accomplish. If i had to perform that sub again on a different column, and add those results to columns AFTER the original WITH function.

For example: The columns of sheet2 now read Dog, Cat, Pony. How can I read another range and display (Ex Big, Medium, Small) dynamically into the next 3 columns?

The columns in question are selected from an input box, ( dim type as range, dim size as range).
 
Upvote 0
Private Sub CommandButton1_Click()


Dim TestColumn1 As Range
Dim TestColumn2 As Range
Dim LR As Long
Dim Cl As Range




'Select the two columns of interest


Set TestColumn = Application.InputBox(prompt:="Select Test Column", Title:="Test Column", Default:="A1", Type:=8)
Set TestColumn2 = Application.InputBox(prompt:="Select Test Column2", Title:="Test Column2", Default:="A1", Type:=8)


'Display total number of columns in Cell (for debugging)
LR = ActiveSheet.UsedRange.Rows.count
Range("C1").Value = LR


'From Mr Excel

With CreateObject("scripting.dictionary")
For Each Cl In Range("A2", Range("A" & Rows.count).End(xlUp))
If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
Next Cl
Sheets("workspace").Range("A1").Resize(, .count) = .keys
End With


'How to display the count of the number of columns from the previous WITH?




End Sub
 
Upvote 0
Try
Code:
Private Sub CommandButton1_Click()

   Dim TestColumn1 As Range
   Dim TestColumn2 As Range
   Dim LR As Long
   Dim Cl As Range
   Dim i As Long, Col As Long
   
   'Select the two columns of interest
   
   Set TestColumn1 = Application.InputBox(prompt:="Select Test Column1", title:="Test Column1", Default:="A1", Type:=8)
   Set TestColumn2 = Application.InputBox(prompt:="Select Test Column2", title:="Test Column2", Default:="A1", Type:=8)
   
   'Display total number of columns in Cell (for debugging)
   LR = ActiveSheet.UsedRange.Rows.Count
   Range("C1").Value = LR
   
   'From Mr Excel
   Col = TestColumn1.Column
   With CreateObject("scripting.dictionary")
      For i = 2 To 3
         If i = 3 Then Col = TestColumn2.Column
         For Each Cl In Range(Cells(2, Col), Cells(LR, Col))
            If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
         Next Cl
         Sheets("workspace").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, .Count) = .keys
         Sheets("workspace").Range("A" & i).Value = .Count
         .removeall
      Next i
   End With
   
   'How to display the count of the number of columns from the previous WITH?
End Sub
PS. when posting code please use code tags, the # icon in the reply window
 
Upvote 0
Awesome, I can get that to work if the CommandButton is on the same sheet as the Test Columns. The issue I now have is getting it to function across separate worksheets . Example: Button is on Sheet1, testcolumn1 and testcolumn2 are in sheet 2, and the output needs to be on sheet 3.
 
Upvote 0
Ok, try
Code:
Private Sub CommandButton1_Click()

   Dim TestColumn1 As Range
   Dim TestColumn2 As Range
   Dim LR As Long
   Dim Cl As Range
   Dim i As Long, Col As Long
   Dim Ws1 As Worksheet
   
   'Select the two columns of interest
   Set Ws1 = Sheets("sheet2")
   Set TestColumn1 = Application.InputBox(prompt:="Select Test Column1", title:="Test Column1", Default:="A1", Type:=8)
   Set TestColumn2 = Application.InputBox(prompt:="Select Test Column2", title:="Test Column2", Default:="A1", Type:=8)
   
   'Display total number of columns in Cell (for debugging)
   LR = Ws1.UsedRange.Rows.Count
   Range("C1").Value = LR
   
   'From Mr Excel
   Col = TestColumn1.Column
   With CreateObject("scripting.dictionary")
      For i = 2 To 3
         If i = 3 Then Col = TestColumn2.Column
         For Each Cl In Ws1.Range(Ws1.Cells(2, Col), Ws1.Cells(LR, Col))
            If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
         Next Cl
         Sheets("workspace").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, .Count) = .keys
         Sheets("workspace").Range("A" & i).Value = .Count
         .removeall
      Next i
   End With
   
   'How to display the count of the number of columns from the previous WITH?
End Sub
 
Upvote 0
That worked really well. Now I have a new problem. I solved it but it, is not efficient.


Ex: If i had a column titled Animals that has unique values of Pony, Cat, Dog...
I need a new worksheet with 3 columns titled Pony, Cat, Dog and all of the original values listed below.
Reason: I filldown a formula to return a 1 or 0 using the value in the first cell of the column so I can use a Pivot table to analyze the data.

Column1[Animal, Dog, Dog Cat, Cat, Pony, Dog]

Becomes
Column1[dog, 1, 1, 0, 0, 0, 1]
Column2[cat, 0, 0, 1, 1, 0, 0]
Column3[pony, 0, 0, 0, 0, 1, 0]

Code below prompts the user to input 3 columns, the 2 of interest in this problem are "StatusColumn" and "Causedbycolumn"

Is there a more efficient way of doing this? My solution below is childish, but it works.

Code:
Private Sub CommandButton3_Click()



Dim ControlColumn As Range
Dim StatusColumn As Range
Dim CausedBycolumn As Range
Dim LR As Long
Dim Cl As Range
Dim i As Long, Col As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Statuscount As Integer, Causedbycount As Integer, Offset As Integer




   
'Select the three columns of interest
   Set Ws1 = Sheets("POAM Entries destination")
   Set Ws2 = Sheets("Workspace")
   Sheets("POAM entries destination").Select
   Set ControlColumn = Application.InputBox(prompt:="Select Control Column", Title:=" Control Column", Default:="A1", Type:=8)
   Set StatusColumn = Application.InputBox(prompt:="Select Status Column", Title:="Status Column", Default:="A1", Type:=8)
   Set CausedBycolumn = Application.InputBox(prompt:="Select Caused By Column", Title:="Caused by Column", Default:="A1", Type:=8)


   
'Display total number of columns in Cell (for debugging)
   LR = Ws1.UsedRange.Rows.Count
   
'From Mr Excel -
   Col = StatusColumn.Column
   With CreateObject("scripting.dictionary")
      For i = 2 To 3
         If i = 3 Then Col = CausedBycolumn.Column
         For Each Cl In Ws1.Range(Ws1.Cells(2, Col), Ws1.Cells(LR, Col))
            If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
         Next Cl
         Ws2.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).resize(, .Count) = .keys
         Ws2.Range("A" & i).Value = .Count
         .RemoveAll
      Next i
   End With
   
   Ws2.Select
   Ws2.Range("A2").Activate
   Statuscount = ActiveCell.Value
   Ws2.Range("A3").Activate
   Causedbycount = ActiveCell.Value
   
   Offset = Statuscount - 1
   MsgBox "The value of offset is " & Offset, vbInformation
        
Ws2.Select
Ws2.Rows(1).EntireRow.Copy
Sheets("Workspace2").Select
Sheets("Workspace2").Rows(1).Select
Sheets("Workspace2").Paste


 For i = 2 To Statuscount
     LR = Ws1.UsedRange.Rows.Count
     Ws2.Select
     StatusColumn.Copy
     Ws2.Cells(1, i).PasteSpecial Paste:=xlPasteValues
 Next i
 
 For j = (Statuscount + 1) To (Statuscount + Causedbycount - 1)
     LR = Ws1.UsedRange.Rows.Count
     Ws2.Select
     CausedBycolumn.Copy
     Ws2.Cells(1, j).PasteSpecial Paste:=xlPasteValues
 Next j
 
Sheets("Workspace2").Rows(1).EntireRow.Copy
Ws2.Rows(1).Select
Ws2.Paste


End Sub
 
Upvote 0
How about
Code:
   Statuscount = Ws2.Range("A2").Value
   Causedbycount = Ws2.Range("A3").Value
   
   Offset = Statuscount - 1
   MsgBox "The value of offset is " & Offset, vbInformation
        
   Sheets("Workspace2").Rows(1).Value = Ws2.Rows(1).Value
   LR = Ws1.UsedRange.Rows.Count

   For i = 2 To Statuscount
       StatusColumn.Copy
       Ws2.Cells(1, i).PasteSpecial Paste:=xlPasteValues
   Next i
   
   For j = (Statuscount + 1) To (Statuscount + Causedbycount - 1)
       CausedBycolumn.Copy
       Ws2.Cells(1, j).PasteSpecial Paste:=xlPasteValues
   Next j
    
   Ws2.Rows(1).Value = Sheets("Workspace2").Rows(1).Value
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,306
Members
452,633
Latest member
DougMo

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