VBA - loop - if cell cotains then .textocolumns

[Jonstrup]

Hi all

I am having trouble with combining the .textotocolumn function with if statements. The posts I have found all have fixed/specified ranges such as destination cell A1 and range A:A.

My data insn't always imported the same way. Both the columns and the format varies which is why I would like to make a vba code that searches through the dataset.

If a cell contains "Start date" or "End date" i would like to use the text to column function changing to the date format on the entire column. Thus my search variables would be A "Start date", B "End date"

I have tried recording a macro to see how the function looks like and it seems it needs both the entire column selected and the first cell of the selected range as destination.

It looks something like this:
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
ActiveWindow.SmallScroll Down:=12

Below I have tried to make a loop that searches for a text string but I can't get to dynamically set both a range pointing at the cell contain the textstring and then select the entire column. I know it is me not doing
it right, so I would really appreciate some help.


Sub FormatText()


Dim MyRange As Range
Set MyRange = ActiveCell.Offset(1, 0)


For i = ActiveSheet.Columns.Count To 1 Step -1
If InStr(1, Cells(1, i), "some text") Then Columns(i).EntireColumn.Select


Selection.TextToColumns Destination:=Range(MyRange), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True

Best regards
Kasper

 

[Jonstrup]

Hi agian

So.. I have sort of managed to solve this with further investigating online. Current solution only works for a specific table name.

So if any one can offer help with a variable so I can use my solution for with any table - the current one point at table3 but I need to make a solution that works with tables in the active sheet. The reason being I am trying to help my coworker who will be importing data, making a new table which will then always have a new number TableN+1.

Sub x()

Dim Afsnit As String
Dim SogA As String
Dim Reafs As String
Dim ("danish word for end" = US derogatory word for fun women) As ListObject
Dim Start As ListObject


Dim STH As String
Dim SDH As String


STH = "Header name1"
SDH = "Headername2"


Set Start = ActiveSheet.ListObjects(1)


Cells.Find(What:=STH, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("Tabel3[Headername1]").Select
Selection.TextToColumns Destination:=Start.DataBodyRange.Cells(1, Start.ListColumns(STH).Index), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True

'use the .texttocolums to format the date for 2 columns


Cells.Find(What:=SDH, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range("Tabel3[Headername2]").Select
Selection.TextToColumns Destination:=Start.DataBodyRange.Cells(1, Start.ListColumns(SDH).Index), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True




'search for a specific header name and change all values in the column based on input box


SogA = "Afd"
Reafs = Application.InputBox("Indtast Afsnitsnavn - Indtastning sætter samme afsnitsnavn for alle personer")


Cells.Find(What:=SogA, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("Tabel3[Afd]").Value = Reafs

end sub