Search Row 1 for Text if Found Convert Column to Date

airforceone

Board Regular
Joined
Feb 14, 2022
Messages
201
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
good day mate,

I decided to try converting my MS Access Form to Excel Userform (have a valid reason), so my would be series of question for the days ahead :) starts now...
I have a Table with a Header with different capitalization of text entry (ie. Date, DATE, DaTe, date)
what I would like to achieve is search the first row (table header) is such header contains a string of "date" in it, that particular column gets converted to DATE format (dd/mm/yyyy) in the included Sample Table four (4) columns should be converted to DATE format
I search a few dozen excel forum already but came up empty. so far code includes,

CCTO

VBA Code:
Dim rFind As Range
With ThisWorkbook.Sheets("Sheet1").Rows(1)
    Set rFind = .Find(What:="*DATE*", Lookat:=xlPart, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        MsgBox "Col: " & rFind.Column & ", Row: " & rFind.Row
    End If
End With

'2nd example

For Each Ws In ActiveWorkbook.Worksheets
    With Ws
        If .Index <> 1 Then
        Dim rngSearch As Range, rngLast As Range, rngFound As Range
        Dim strFirstAddress As String
        Set rngSearch = .Range("A1:CH1")   
        Set rngLast = rngSearch.Cells(rngSearch.Cells.Count)   
        Set rngFound = rngSearch.Find("*DATE*", after:=rngLast, LookIn:=xlValues, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
            If Not rngFound Is Nothing Then
                strFirstAddress = rngFound.Address
                Do
                    Set rngFound = rngSearch.FindNext(rngFound)       
                    DEBUG.PRINT strFirstAddress
                Loop Until rngFound.Address = strFirstAddress
            End If
        End If
    End With
Next Ws

Sample Table
ULTIMATE GENERATOR.xlsm
ABCDEFGHIJKLMN
1col 1col 2date enrolledcol 3col 6Date Exitedcol 8col 10DATE Returnedcol 12col 13DaTe Encodedcol 15time Encoded
2lorem sumlorem sum2016-01-14lorem sumlorem sum2016-01-14lorem sumlorem sum2016-04-06 11:56:00lorem sumlorem sum2016-01-14lorem sum10:30:00
3lorem sumlorem sum2015-12-31lorem sumlorem sum2016-01-01lorem sumlorem sum2016-04-07 02:50:55lorem sumlorem sum2015-12-31lorem sum13:15:00
4lorem sumlorem sum2016-01-03lorem sumlorem sum2016-01-03lorem sumlorem sum2016-04-07 04:50:40lorem sumlorem sum2016-01-03lorem sum07:50:00
5lorem sumlorem sum2016-01-06lorem sumlorem sum2016-01-06lorem sumlorem sum2016-04-07 11:15:51lorem sumlorem sum2016-01-06lorem sum11:30:00
6lorem sumlorem sum2016-01-06lorem sumlorem sum2016-01-06lorem sumlorem sum2016-04-07 11:44:58lorem sumlorem sum2016-01-06lorem sum19:00:00
7lorem sumlorem sum2016-01-08lorem sumlorem sum2016-01-08lorem sumlorem sum2016-04-07 12:03:21lorem sumlorem sum2016-01-08lorem sum14:20:00
8lorem sumlorem sum2016-01-09lorem sumlorem sum2016-01-09lorem sumlorem sum2016-04-07 12:31:30lorem sumlorem sum2016-01-09lorem sum19:50:00
9lorem sumlorem sum2016-01-15lorem sumlorem sum2016-01-15lorem sumlorem sum2016-04-07 13:12:07lorem sumlorem sum2016-01-15lorem sum18:40:00
10lorem sumlorem sum2016-01-16lorem sumlorem sum2016-01-16lorem sumlorem sum2016-04-07 13:25:24lorem sumlorem sum2016-01-16lorem sum21:55:00
11lorem sumlorem sum2016-01-17lorem sumlorem sum2016-01-17lorem sumlorem sum2016-04-07 13:39:07lorem sumlorem sum2016-01-17lorem sum23:10:00
12lorem sumlorem sum2016-01-17lorem sumlorem sum2016-01-17lorem sumlorem sum2016-04-07 13:57:58lorem sumlorem sum2016-01-17lorem sum23:50:00
13lorem sumlorem sum2016-01-17lorem sumlorem sum2016-01-17lorem sumlorem sum2016-04-07 17:35:44lorem sumlorem sum2016-01-17lorem sum09:45:00
14lorem sumlorem sum2016-01-20lorem sumlorem sum2016-01-20lorem sumlorem sum2016-04-07 17:52:26lorem sumlorem sum2016-01-20lorem sum23:35:00
15lorem sumlorem sum2016-01-19lorem sumlorem sum2016-01-19lorem sumlorem sum2016-04-08 00:46:37lorem sumlorem sum2016-01-19lorem sum04:10:00
16lorem sumlorem sum2016-01-30lorem sumlorem sum2016-01-30lorem sumlorem sum2016-04-08 01:40:00lorem sumlorem sum2016-01-30lorem sum00:30:00
17lorem sumlorem sum2016-01-30lorem sumlorem sum2016-01-30lorem sumlorem sum2016-04-08 01:57:10lorem sumlorem sum2016-01-30lorem sum14:50:00
18lorem sumlorem sum2016-01-31lorem sumlorem sum2016-01-31lorem sumlorem sum2016-04-08 02:11:56lorem sumlorem sum2016-01-31lorem sum03:00:00
19lorem sumlorem sum2016-02-01lorem sumlorem sum2016-02-03lorem sumlorem sum2016-04-08 06:45:30lorem sumlorem sum2016-02-01lorem sum12:45:00
20lorem sumlorem sum2016-02-03lorem sumlorem sum2016-02-03lorem sumlorem sum2016-04-08 10:11:47lorem sumlorem sum2016-02-03lorem sum22:05:00
Sheet1 (3)
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Hi,
see if this code will do what you want

Rich (BB code):
Sub airforceone()
    Dim objTable    As ListObject
    Dim c           As Long
    Dim HeaderArr   As Variant, Header As Variant
    
    'CHANGE sheet name as required
    Set objTable = Worksheets("Sheet1").ListObjects(1)
    
    HeaderArr = objTable.HeaderRowRange.Value
    
    c = 1
    For Each Header In HeaderArr
        If UCase(Header) Like "*DATE*" Then objTable.DataBodyRange.Columns(c).NumberFormat = "dd/mm/yyyy"
    c = c + 1
    Next Header

End Sub

Change sheet name as required

Dave
 
Upvote 0
Hi,
see if this code will do what you want

Rich (BB code):
Sub airforceone()
    Dim objTable    As ListObject
    Dim c           As Long
    Dim HeaderArr   As Variant, Header As Variant
   
    'CHANGE sheet name as required
    Set objTable = Worksheets("Sheet1").ListObjects(1)
   
    HeaderArr = objTable.HeaderRowRange.Value
   
    c = 1
    For Each Header In HeaderArr
        If UCase(Header) Like "*DATE*" Then objTable.DataBodyRange.Columns(c).NumberFormat = "dd/mm/yyyy"
    c = c + 1
    Next Header

End Sub

Change sheet name as required

Dave
unfortunately mate doesn't seems to work, I added a Debug.Print "FOUND AT " & c after the if UCase line to check which columns was identified but the if statement does not work... :(
 
Upvote 0
This may work. You may have to change Workbooks("Book1") to your WorkBook name and change "Sheet1" to your Sheet name.
VBA Code:
Sub getdate()
Dim wb As Workbook, sht As Worksheet, rng As Range, cell As Range
Set wb = Workbooks("Book1"): Set sht = wb.Worksheets("Sheet1"): Set rng = sht.Range(Cells(1, 1), Cells(1, sht.Columns.Count))
For Each cell In rng
    If cell.Value = "date" Then
        sht.Columns(cell.Row).NumberFormat = "m/d/yyyy"
    End If
Next cell
End Sub
 
Upvote 0
This may work. You may have to change Workbooks("Book1") to your WorkBook name and change "Sheet1" to your Sheet name.
VBA Code:
Sub getdate()
Dim wb As Workbook, sht As Worksheet, rng As Range, cell As Range
Set wb = Workbooks("Book1"): Set sht = wb.Worksheets("Sheet1"): Set rng = sht.Range(Cells(1, 1), Cells(1, sht.Columns.Count))
For Each cell In rng
    If cell.Value = "date" Then
        sht.Columns(cell.Row).NumberFormat = "m/d/yyyy"
    End If
Next cell
End Sub
sorry mate it's a no go also...
 
Upvote 0
this code works but could only find the first occurrence, any idea what code is missing to identify all four columns/header with the word "DATE" in it....

Rich (BB code):
Dim rFind As Range, iCharNum As Integer, LColChar As String

With Worksheets("SheetKho").Range("A1:CH1")
    Set rFind = .Find(What:="DATE", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not rFind Is Nothing Then
        iCharNum = rFind.Column
        LColChar = Split(Cells(1, iCharNum).Address, "$")(1)
        Debug.Print LColChar
    End If
End With
 
Upvote 0
Yeah. If you're using Find, you have to combine it with FindNext with Loop.
 
Upvote 0
**** simplicity is the key!
got some misc code sleeping under my finger and got it working with only the following code...

Rich (BB code):
    ColSource = Sheets("SheetKho").Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To ColSource
        If UCase(Cells(1, i).Value) Like "*DATE*" Then
            Debug.Print "Search value found at Column: " & i
        End If
    Next i
 
Upvote 0
Solution
Code should work OK but I suspect your data us then in a Range rather than a Table as you originally stated.

Dave
 
Upvote 0
Code should work OK but I suspect your data us then in a Range rather than a Table as you originally stated.

Dave
normally mate I create a new workdata for my posted question and use any given code on that workdata, all the code were tested on the same workdata changing the sheet name and range accordingly. If in anyway I mistakenly made a blunder with your code, sorry mate :). will review again later.....
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top