Format column based on text in row 1

[ChrissyO]

Hi,

I've been trying to write a macro for the past 2 days and I'm really struggling.

I'm trying to write the macro to search through all of row 1 (varying data size) and if the column header contains the word "DATE" I want to format the entire column as a date. However, the data I'm dealing with holds dates as YYYYMMDD so I need to format the dates using the text to columns YMD function and I'm not sure if this is possible with a macro.

Any help or guidance on the matter would be greatly appreciated

Thanks

 

[Weaver]

This macro might help - try on a copy of your data first

Sub test()
    For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        If InStr(UCase(Cells(1, c)), "DATE") > 0 Then
            For Each r In Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
                r.Value = Right(r.Value, 2) & "/" & Mid(r.Value, 5, 2) & "/" & Left(r.Value, 4)
            Next r
        End If
    Next c
End Sub

 

[ChrissyO]

Thanks for the quick response.

The macro works, however if some of the cells are blank or contain "0" it returns
"0//0" or "//", whereas the text to columns YMD just keeps them as blank or zero. Is there anyway I could change the formatting logic to include this method?

Thanks

 

[Weaver]

either side of the line starting

r.Value =

we need to drop in an if condition

if r.value>0 then
r.Value = 
end if

HTH

 

[ChrissyO]

I've tried updating it a couple of ways as per your response but it still doesn't seem to be working. The first way changd all the dates to the value in A1 and the second returned a debug error "object not found".

Heres my current code below:

Sub test()
    For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        If InStr(UCase(Cells(1, c)), "DATE") > 0 Then
            For Each r In Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
                If r.Value > 0 Then
                r.Value = EntireColumn.Select
                
                Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                :=Array(1, 5), TrailingMinusNumbers:=True
                        
                End If
            Next r
        End If
    Next c
End Sub

Apologies if I've missed something really simple, I am new to this but find it extremely interesting (when I get my head around it)

 

[Peter_SSs]

For Text to Columns, you don't need to do each individual cell in the column. You also don't (usually) need to select things to work with them in vba and selecting slows your code. Try this modification to your code (in a copy of your workbook).

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> test()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">For</SPAN> c = 1 <SPAN style="color:#00007F">To</SPAN> Cells(1, Columns.Count).End(xlToLeft).Column<br>        <SPAN style="color:#00007F">If</SPAN> InStr(UCase(Cells(1, c).Value), "DATE") > 0 <SPAN style="color:#00007F">Then</SPAN><br>            Columns(c).TextToColumns Destination:=Cells(1, c), DataType:=xlDelimited, _<br>                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _<br>                Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _<br>                :=Array(1, 5), TrailingMinusNumbers:=<SPAN style="color:#00007F">True</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[ChrissyO]

That makes sense and is good to know.

The code works brilliantly. Thank you so much for your help.