Help counting and copying unique values.

[joe97281]

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.

 

[Fluff]

Hi & welcome to MrExcel
How about

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

 

[joe97281]

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

 

[Fluff]

Could you supply your code?

 

[joe97281]

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

 

[Fluff]

Try

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

 

[joe97281]

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.

 

[Fluff]

Ok, try

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

 

[joe97281]

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.

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

 

[Fluff]

How about

   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