W. Hesler
W. Hesler

Reputation: 27

VBA Macro to Scan Header Row and Alter Column Data Types

I frequently paste data from my SSMS query results into Excel to then analyze the data further from there.

When pasting datetime stamps into Excel, the format comes through pretty messy. I constantly find myself changing these columns to the ShortDate data type.

What I am trying to accomplish is to write a macro that scans row 1 for any header like '%Date%' and changes the entire column to the ShortDate data type.

Can anyone point me in a direction to get started? Thanks!

Upvotes: 0

Views: 508

Answers (4)

user4039065
user4039065

Reputation:

Looking at the header column labels has pretty much been dealt with so I'll tackle examining the data itself.

dim c as long
with worksheets(1)
    with .cells(1, 1).currentregion
        for c=1 to .columns.count
            'this only looks at the second row; a nested loop here could look at more rows
            if isdate(.cells(2, c)) then .columns(c).numberformat = "m/d/yyyy;@"
        next c
    end with
end with

Upvotes: 1

Tom
Tom

Reputation: 9878

You could use the Find function to find your fields that contain the word date in your header row (using row 1 in my example) and then apply a NumberFormat to them

Public Sub FormatDates()
    Dim firstAddress As String
    Dim HeaderRow As Long
    Dim c As Range

    ' Change to your header row
    HeaderRow = 1
    ' Change to your sheet
    With Sheet1
        With .Range(.Cells(HeaderRow, 1), .Cells(HeaderRow, .Cells(HeaderRow, .Columns.Count).End(xlToLeft).Column))
            Set c = .Find(what:="Date", lookat:=xlPart)

            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Debug.Print c.Address
                    c.EntireColumn.NumberFormat = "dd/mm/yy"
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    End With
End Sub

Upvotes: 1

TXP
TXP

Reputation: 59

This should do it:

Sub changeDateFormat()
Dim i As Long
  With ThisWorkbook.Sheets(1)
    For i = 1 To Application.CountA(.Rows(1))
      If LCase(.Cells(1, i).Value2) Like "*date*" Then .Columns(i).NumberFormat = "dd/mm/yyyy"
    Next i
  End With
End Sub

Upvotes: 1

YasserKhalil
YasserKhalil

Reputation: 9548

try this code

Sub Test()
    Dim c As Range

    For Each c In Range("A1").CurrentRegion.Rows(1).Cells
        If InStr(LCase(c.Value), "date") > 0 Then
            c.EntireColumn.NumberFormat = "m/d/yyyy"
        End If
    Next c
End Sub

Upvotes: 2

Related Questions