Ana
Ana

Reputation: 119

Macro /excel date format change

I am trying to add to add French version to my code. I have macro that reads from text file report and extracts dates in correct format. Text file date format is JUL13/2023. My macro works just fine but sometimes dates appear in French - JAN - January, F:V – February, MAR - March, AVR - April, MAI- May, JUN - June, JLT - July, AO} – August, SEP – September, OCT – October, NOV - November, D:C – December. I am trying to find the best solution to add it into my code so it can read all possible dates and give me just regular date format as an output. Here is my code:

 Sub test()
    Dim fn As String, mtch As Object, m As Object, s As Object, txt As String
    Dim i As Long
    
    fn = "C:\temp\test.txt"
    
    txt =CreateObject("scripting.filesystemobject").OpenTextFile(fn).ReadAll
     With CreateObject("vbscript.regexp")
     .Global = True
     .Pattern = "[^\n]+"
     Set mtch = .Execute(txt)
     
     i = 1
     Dim b As Long
     b = 1
     For Each m In mtch
     .Pattern = "[a-zA-Z0-9]{7}\s\s[^\s]+\s[a-zA-Z\s]*[0-9]{2}\/[0-9]{4}"
     

        
        For Each s In .Execute(m.Value)
           i = i + 1
           Cells(i, 1) = s
           b = b + 1
           Range("B" & b).Value = Right(Cells(i, 1), 10)
        
        Next
        Next
     End With
    
  
    Dim var As String   
    Dim N As Long, p As Long, j As Long
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    
    For p = 2 To N
            var = Range("B" & p).Value  
            Range("C" & p).Value = convert_date(var)
            Range("D" & p).Value = Range("C" & p) + 179
            Range("E" & p).Value = Range("C" & p) + 209
            j = j + 1
    Next p
        
End Sub


Function convert_date(date_as_string As String) As Date
   Dim mthstring As String
   mthstring = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
   convert_date = DateSerial( _
   CInt(Right(date_as_string, 4)), _
   CInt(((InStr(1, mthstring, Left(date_as_string, 3)) - 1) / 4) + 1), _
   CInt(Replace(Mid(date_as_string, 4, 2), "/", "")))
End Function


Sub testConvertDate()
    Dim var As String
    Dim N As Long, i As Long, j As Long
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    Dim m As Integer
    For i = 2 To N
            'Range("B" & i).Value = Right("A" & i, 10)
            var = Range("B" & i).Value
            
            Range("C" & i).Value = convert_date(var)
            Range("D" & i).Value = Range("C" & i) + 179
            Range("E" & i).Value = Range("C" & i) + 209
            j = j + 1
    Next i
End Sub

And here is my outcome: enter image description here

Upvotes: 0

Views: 107

Answers (2)

FaneDuru
FaneDuru

Reputation: 42256

Because of the fact that your French months name enumeration contains strings of 3 or 4 characters, you need to process the string Date in a different way. Please, try the next adapted function. Do not miss to also copy the function returning only numbers (onlyNo):

Function convert_date(date_as_string As String) As Date
   Dim mthstring As String, strLeft As String, arrD, dayNo As Long, monthNo As Long, y As Long

   mthstring = "JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC"
   arrD = Split(mthstring, ",") 'place the string in an array
   y = CLng(Split(date_as_string, "/")(1)) 'extract the year
   strLeft = Split(date_as_string, "/")(0) 'extract the left string Date split by "/"
   dayNo = onlyNo(strLeft)                 'extract the day number
   monthNo = Application.match(left(strLeft, Len(strLeft) - Len(CStr(dayNo))), arrD, 0) 'extract the month number

   convert_date = DateSerial(y, monthNo, dayNo) 'convert to Date
End Function

Private Function onlyNo(strX As String) As Long
     With CreateObject("vbscript.regexp")
       .Pattern = "[^0-9]"  'replace everything except numbers
       .Global = True
       onlyNo = CLng(.replace(strX, "")) 'remove all letters
    End With
End Function

The function should be called exactly as in your existing code.

You can simple test it using the next testing Sub. Please, uncomment the commented lines one by one and run it:

Sub testConvert_Date()
    Dim d As String
    d = "MAI31/2022"
    'd = "JUIN20/2022"
    'd = "NOV4/2022"
    Debug.Print convert_date(d)
End Sub

If you need to adapt the function to work, at request, for English days name, too, I can easily adapt the function creating another parameter to select between languages.

Please, send some feedback after testing it.

Upvotes: 1

CDP1802
CDP1802

Reputation: 16322

Option Explicit

Function convert_date(s As String) As Date
    Dim ar, arLang(1), regex, v
    Dim y As Integer, m As String, d As Integer
    
    arLang(0) = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
    arLang(1) = Split("JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")
    
    Set regex = CreateObject("vbscript.regexp")
    With regex
       .Global = False
       .MultiLine = False
       .Ignorecase = True
       .Pattern = "([A-Z]+)(\d{1,2})\/(\d{4})"
    End With
    
    If regex.test(s) Then
        With regex.Execute(s)(0)
            m = .submatches(0)
            d = .submatches(1)
            y = .submatches(2)
        End With
    
        For Each ar In arLang
            v = Application.Match(m, ar, 0)
            If Not IsError(v) Then
                convert_date = DateSerial(y, CInt(v), d)
                Exit Function
            End If
        Next
    End If
    MsgBox s & " not correct format", vbExclamation
  
End Function

Upvotes: 0

Related Questions