Results 1 to 3 of 3

Thread: VBA (Macro) to Parse multiple Adjacent Text Columns

  1. #1

    VBA (Macro) to Parse multiple Adjacent Text Columns

    Register for a FREE account, and/
    or Log in to avoid these ads!

    Dear All,
    I have a number of adjacent columns most of the columns contain a list of names and separated by a Semicolon ;, some cells contains a single name without Semicolon.

    I like to know if there is a VBA (Macro) that parse each column based on the Semicolon delimiter for ALL the columns at once. (if possible paste the results in a new sheet OR in the same sheet)

    I have attached a sample of the Original Data set in sheet 1 and the Desired Outcome in sheet 2. In Sheet 1, I like to parse Column C through Column G

    The real data set contains dozens of columns and thousands of rows.
    Help is greatly appreciated.

    Attached Files Attached Files

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Excel Version
    the following macro seems to work on your file.
    It works on the active sheet, so make sure that's the right one before you run it.
    It puts the results on a new sheet:
    Sub blah()
    Dim DestnSht As Worksheet
    Set SourceSht = ActiveSheet
    Set DestnSht = Sheets.Add(After:=Sheets(Sheets.Count))
    Set SourceRng = SourceSht.Range("A1").CurrentRegion
    RowCount = SourceRng.Rows.Count
    With DestnSht
      .Cells(1, 1).Resize(RowCount).Value = SourceRng.Columns(1).Value
      DestnColumn = 2
      For c = 3 To SourceRng.Columns.Count
        If UCase(Left(SourceRng.Columns(c).Cells(1), 4)) = "TEAM" Then
          Set DestRng = .Cells(1, DestnColumn).Resize(RowCount)
          DestRng.Value = SourceRng.Columns(c).Value
          DestRng.TextToColumns Destination:=DestRng, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Semicolon:=True
          DestnColumn = .UsedRange.Columns.Count + 1
        End If
      Next c
      'optional for next loop to add person count in cell comment if missing or different:
      For Each rw In .UsedRange.Offset(1, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count - 1).Rows
        If rw.Cells(1).Offset(, -1).Value <> Application.CountA(rw) Then rw.Cells(1).Offset(, -1).AddComment CStr(Application.CountA(rw))
      Next rw
    End With
    End Sub

  3. #3
    Dear P45cal
    Many thanks for your great help. It worked fine and I am about to test it on a large datasets.
    All the best Taisir

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts