CODEWITHSUNDEEP
excelvba
ggmkp
ggmkp

Reputation: 725

Excel VBA / Macro - TextToColumns for multiple columns?

Is there way to find cell that contains "Date" and run the TextToColumns macro? instead of referencing column "H" or "J" and/or so on...

Ultimately I am trying to change about 5 columns that contains "~ Date" to TextToColumn. And it's not always on the "H" column.

Thank you so much for your expertise

Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 5), TrailingMinusNumbers:=True

Upvotes: 1

Views: 3995

Answers (1)

chuff
chuff

Reputation: 5866

Assuming that the "date" values are to be found in the column headers for row 1, the following code should do the trick.

It works as follows:

  • find the rightmost column header in row 1

  • loop through the first to last header

  • search for the string "date" within each header cell

    -- if not found, go to the next header cell

    -- if found, then convert the text values of the column of date for that header into columns and go to the next header cell

Note that I removed the Selects from the code, which are not necessary to do the conversions.

Your description was not clear on whether there were enough blank columns to the right of a "date"-headed column to hold the split data without overwriting other existing data. This procedure assumes that there is enough room. As a result, if there is data in the cells to the right, Excel will show a dialog box asking if you want to overwrite the adjacent cell. If there is not, and additional columns need to inserted, please modify your question to make that clear.

  Sub txttocol()

      Dim ws As Sheet1
      Dim rng As Range
      Dim lastCol As Long
      Dim i As Long

      Set ws = Worksheets("Sheet1")
      With ws
          lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
          For i = 1 To lastCol
              If InStr(UCase(.Cells(1, i).Value), UCase("date")) <> 0 Then
                  Set rng = .Range(Columns(i), Columns(i))
                  rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                      Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                      :=Array(1, 5), TrailingMinusNumbers:=True
              End If
          Next i
      End With
  End Sub

Upvotes: 1

Related Questions