Transposing Column data into rows, with unique values only

[stevedhawes]

Morning Folks,

Hoping someone can help me this a problem, as ive not been able to find anything online to answer my query.

I currently have colour names on worksheet "a" range E3:S102, and i aim aiming to find a quick way to be able to query the values in these cells, and return only unique colours in a vertical list on worksheet "b" @ range a1.

I would like this to happen dynamically, for example when tab b is activated, if possible.

Any help gratefully received, as this one is really baffling me

Best
Steve

 

[ParamRay]

Must be placed in code module for worksheet "b":

Private Sub Worksheet_Activate()

  Dim UniqueVals() As Variant
  Dim UniqueCount As Long
  Dim Exists As Boolean
  Dim Cell As Range
  Dim i As Long
  
  Me.Columns("A").ClearContents
  
  For Each Cell In ThisWorkbook.Worksheets("a").Range("E3:S102")
    Exists = False
    If UniqueCount > 0 Then
      For i = LBound(UniqueVals) To UBound(UniqueVals)
        If Cell.Text = UniqueVals(i) Then
          Exists = True
          Exit For
        End If
      Next i
    End If
    If Not Exists Then
      UniqueCount = 1 + UniqueCount
      ReDim Preserve UniqueVals(1 To UniqueCount)
      UniqueVals(UniqueCount) = Cell.Text
    End If
  Next Cell
  
  If UniqueCount > 0 Then
    Me.Range("A1").Resize(UniqueCount).Value _
      = Application.Transpose(UniqueVals)
  End If
  
  Me.Columns("A").AutoFit

End Sub

 

[stevedhawes]

Cant thank you enough!!

Work perfectly. can feel the headache easing already!!

Best
Steve