Macro to sort dynamic list into table

Andrew

See how this goes.

Sub extracter()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Table")
  OutSH.Cells.ClearContents
  OutSH.Range("A1:F1").Value = Array("Name", "Location", "Telephone", "Email", "Web Site", "Description")
  
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row - 3
    If Not IsEmpty(Cells(i, 1)) And InStr(1, Cells(i, 1).Value, ":") = 0 Then
      outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Row + 1
      OutSH.Cells(outrow, 1).Value = Cells(i, 1).Value
    ElseIf Not IsEmpty(Cells(i, 1)) And InStr(1, Cells(i, 1).Value, ":") > 0 Then
      placer = InStr(1, Cells(i, 1).Value, ":")
      outcol = WorksheetFunction.Match(Left(Cells(i, 1).Value, placer - 1), OutSH.Rows("1:1"), 0)
      
      Select Case Left(Cells(i, 1).Value, placer - 1)
        Case "Description"
          OutSH.Cells(outrow, outcol).Value = Cells(i + 1, 1).Value ', Len(Cells(i + 1, 1).Value) - placer))
          i = i + 1
        Case Else
          OutSH.Cells(outrow, outcol).Value = Trim(Right(Cells(i, 1).Value, Len(Cells(i, 1).Value) - placer))
      End Select
    End If
  Next i
          
End Sub

rylo