Formula to extract unique values as a horizontal list

[willow1985]

Hello,

I have tried a few formulas (index match with count if) But I cannot seem to get the results I am looking for.

I have a list of areas that I would like unique values transposed horizontally (see below picture)

Any help would be appreciated ( I think I am missing something in my formula attempts)

Thank you!

 

[Fluff]

How about

Sub Willow()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   Sheets("Score Card").Range("D3").Resize(, Dic.Count).Value = Dic.Keys
End Sub

 

[willow1985]

How about

Sub Willow()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   Sheets("Score Card").Range("D3").Resize(, Dic.Count).Value = Dic.Keys
End Sub

What could I add to this code to clear D3:AA3 any time there is a change to A1 and to re-run the above code?

I want it that every time the year is changed the Areas change as well and the old list removed.

Thank you again Fluff!

 

[Fluff]

How about

Sub Willow()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D3:AA3").ClearContents
      .Range("D3").Resize(, Dic.Count).Value = Dic.Keys
   End With
End Sub

 

[willow1985]

How about

Sub Willow()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D3:AA3").ClearContents
      .Range("D3").Resize(, Dic.Count).Value = Dic.Keys
   End With
End Sub

The code does not seem to be automatically running when the year is changed. I have to manually do it...
Any suggestions?

 

[Dossfm0q]

Hi is it ok

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1	Area	Plant Floor	Zinc Oven	M Saw	Saw	Barrel Line	Parking Lot	Maint Tent	Office	Cell3	Industrial
Sheet4

Cell Formulas
Range	Formula
A1:L1	A1	=IFERROR(INDEX(Sheet1!$A$1:$A$17,SMALL(IF(FREQUENCY(MATCH(Sheet1!$A$1:$A$17,Sheet1!$A$1:$A$17,0),ROW(Sheet1!$A$1:$A$17)-ROW(Sheet1!$A$1)+1),ROW(Sheet1!$A$1:$A$17)-ROW(Sheet1!$A$1)+1),COLUMNS($A$1:A1))),"")
Press CTRL+SHIFT+ENTER to enter array formulas.

 

[Dossfm0q]

For main Post
This is Mr: Fluff Code start From First Cell very simple, easy use and No need to Press CTRL+SHIFT+ENTER to enter array formulas.

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Area	Plant Floor	Zinc Oven	M Saw	Saw	Plant Floor	Parking Lot	Parking Lot	Office	Barrel Line	Industrial
Sheet2

Cell Formulas
Range	Formula
A1:K1	A1	=IFERROR(INDEX(Sheet1!$A$1:$A$34,AGGREGATE(15,6,(ROW(Sheet1!$A$1:$A$34)-1-ROW($A$1)+1)/(ISNA(MATCH(Sheet1!$A$1:$A$34,Sheet1!$A1:A1,0))),1)),"")

 

[Fluff]

@Dossfm0q
No idea how your sheet1 is setup, but with the values in col A only, the formula in post#16 will simply return the same value multiple times.

 

[Fluff]

@willow1985
Assuming that A1 is changed manually try

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Cl As Range
   Dim Dic As Object
   
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "a1" Then
      Set Dic = CreateObject("scripting.dictionary")
      Dic.comparemode = 1
      With Sheets("Log")
         For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
            If Cl.Offset(, -5).Value = Target.Value Then Dic(Cl.Value) = Empty
         Next Cl
      End With
      Me.Range("D3:AA3").ClearContents
      Me.Range("D3").Resize(, Dic.Count).Value = Dic.Keys
   End If
End Sub

 

[willow1985]

@willow1985
Assuming that A1 is changed manually try

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Cl As Range
   Dim Dic As Object
  
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address(0, 0) = "a1" Then
      Set Dic = CreateObject("scripting.dictionary")
      Dic.comparemode = 1
      With Sheets("Log")
         For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
            If Cl.Offset(, -5).Value = Target.Value Then Dic(Cl.Value) = Empty
         Next Cl
      End With
      Me.Range("D3:AA3").ClearContents
      Me.Range("D3").Resize(, Dic.Count).Value = Dic.Keys
   End If
End Sub

Unfortunately still nothing happens when I manually put in a different year in A1

 

[Fluff]

Did you put that in the Score Card sheet module?