Turning a List into a Table

[roseriver]

Hi,
I have a list of data that I want to turn into a table so I can use it for dynamic drop down boxes
I have manually created both but I would love for the list to automatically update the table so when I want to add a new item I don't have to add it in two worksheets
Basically I have a List as such (my actual list is 900 items long):

Food Category	Type
Fruit	Apple
Fruit	Banana
Vegetable	Carrot
Vegetable	Celery
Vegetable	Cauliflower
Nuts	Peanuts

And I would like it to automatically update to a Table such as:

Fruit	Vegetable	Nuts
Apple	Carrot	Peanuts
Banana	Celery
	Cauliflower

I tried pasting it using transpose but this doesn't group the food category and have attempted nesting loops but I keep getting stuck.
I would appreciate any help or ideas.
Thank you

 

[DanteAmor]

Here is a macro for you to consider:
Change "data" and "category" for origin and destination of your sheets.
The macro assumes that the data begins in cell A2.

Sub Turning_List()
  Dim sh1 As Worksheet, sh2 As Worksheet, dic As Object
  Dim a As Variant, b As Variant, i As Long, ky As Variant, v As Long
 
  Set sh1 = Sheets("data")
  Set sh2 = Sheets("Category")
 
  a = sh1.Range("A2", sh1.Range("B" & Rows.Count).End(xlUp)).Value
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1)) Then
      dic(a(i, 1)) = dic(a(i, 1)) & "," & a(i, 2)
    Else
      dic(a(i, 1)) = a(i, 2)
    End If
  Next
 
  i = 1
  sh2.Cells.Clear
  sh2.Range("A1").Resize(1, dic.Count).Value = dic.keys
  For Each ky In dic.keys
    v = Len(dic(ky)) - Len(Replace(dic(ky), ",", "")) + 1
    sh2.Cells(2, i).Resize(v, 1).Value = Application.Transpose(Split(dic(ky), ","))
    i = i + 1
  Next
End Sub

 

[Norie]

Are you sure you need to change the data layout?

Where will your dynamic drop downs be located?

 

[roseriver]

Are you sure you need to change the data layout?

Where will your dynamic drop downs be located?

the drop downs are in a different sheet so if fruit is in one column then the next dropdown will only show the fruits available and I have used MATCH & INDEX in named ranges to create these dropdowns. Is there another way to make these?

 

[roseriver]

Here is a macro for you to consider:
Change "data" and "category" for origin and destination of your sheets.
The macro assumes that the data begins in cell A2.

Sub Turning_List()
  Dim sh1 As Worksheet, sh2 As Worksheet, dic As Object
  Dim a As Variant, b As Variant, i As Long, ky As Variant, v As Long

  Set sh1 = Sheets("data")
  Set sh2 = Sheets("Category")

  a = sh1.Range("A2", sh1.Range("B" & Rows.Count).End(xlUp)).Value
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1)) Then
      dic(a(i, 1)) = dic(a(i, 1)) & "," & a(i, 2)
    Else
      dic(a(i, 1)) = a(i, 2)
    End If
  Next

  i = 1
  sh2.Cells.Clear
  sh2.Range("A1").Resize(1, dic.Count).Value = dic.keys
  For Each ky In dic.keys
    v = Len(dic(ky)) - Len(Replace(dic(ky), ",", "")) + 1
    sh2.Cells(2, i).Resize(v, 1).Value = Application.Transpose(Split(dic(ky), ","))
    i = i + 1
  Next
End Sub

Thank you! this code is a fantastic starting point for what I want! I'm am just going to see if it deletes my named ranges that I have implemented already.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[roseriver]

I'm glad to help you. Thanks for the feedback.

Is there a way to adapt your code so that it will ignore blank cells?
Also I was wondering if the table values could be put into a table that will change shape depending on the number of columns (I don't care about having too many rows)
Is there a line of code that detects the last column and adjusts the size of the table?
Only problem is I don't want to delete my old table and make a new one because it voids my named ranges.
Thanks

 

[Norie]

If you are going to use code why not use it to populate the dynamic dropdown boxes?

If you did that it would meet your requirement regarding changes in the data.

 

[DanteAmor]

Is there a way to adapt your code so that it will ignore blank cells?
I guess you mean a cell in column B on sheet "data"

Also I was wondering if the table values could be put into a table that will change shape depending on the number of columns (I don't care about having too many rows)
Is there a line of code that detects the last column and adjusts the size of the table?
If you have a table in the "category" sheet, it is set to automatic.


Only problem is I don't want to delete my old table and make a new one because it voids my named ranges.
Thanks

Try this:

Sub Turning_List()
  Dim dic As Object, a As Variant, i As Long, v As Long
  
  a = Sheets("data").Range("A2", Sheets("data").Range("B" & Rows.Count).End(xlUp)).Value
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a, 1)
    If a(i, 2) <> "" Then
      If dic.exists(a(i, 1)) Then dic(a(i, 1)) = dic(a(i, 1)) & "," & a(i, 2) Else dic(a(i, 1)) = a(i, 2)
    End If
  Next
  
  With Sheets("Category")
    .Range("A1").Resize(1, dic.Count).Value = dic.Keys
    For i = 1 To dic.Count
      v = Len(dic(dic.Keys()(i - 1))) - Len(Replace(dic(dic.Keys()(i - 1)), ",", "")) + 1
      .Cells(2, i).Resize(v, 1).Value = Application.Transpose(Split(dic(dic.Keys()(i - 1)), ","))
    Next
  End With
End Sub