VBA date clean up

Question

I have some date data that I want to clean up and remove any text that is in the date.

I have the following code that outputs data to a worksheet, and it has a separate datecleanup function that does some of the date cleanup if there is a missing date, or it is only 4 digits, however I am still getting data outputted that contains a mixture of dates and text (examples below).

Main function:

Function TetanusLoad(col As String, col2 As String)

Dim i As Long, j As Long, k As Long

j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1

For i = 2 To lstrow

If Len(Worksheets("Data").Range(col & i).Value) = 0 And 
Len(Worksheets("Data").Range(col2 & i).Value) = 0 Then
GoTo EmptyRange
Else
  strDate = spacedate(Worksheets("Data").Range(col & i).Value)
  Worksheets("CI").Range("A" & j & ":C" & j).Value = 
   Worksheets("Data").Range("F" & i & ":H" & i).Value

Select Case Worksheets("Data").Range(col2 & i).Value
    Case "Tdap"
        Worksheets("CI").Range("D" & j).Value = "TDA"
    Case "Td"
        Worksheets("CI").Range("D" & j).Value = "TD"
    Case Else
        Worksheets("CI").Range("D" & j).Value = "REVIEW"
End Select

Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)

 j = j + 1
End If

EmptyRange:

Next i

End Function

datecleanup function:

Function datecleanup(inputdate As Variant) As Variant

If Len(inputdate) = 0 Then
  inputdate = "01/01/1901"
Else
 If Len(inputdate) = 4 Then
    inputdate = "01/01/" & inputdate
 Else
    If InStr(1, inputdate, ".") Then
        inputdate = Replace(inputdate, ".", "/")
    End If
 End If
End If

datecleanup = inputdate

End Function

Sample data output examples for column E that I am trying to correct:

07/06/1993 - HAD ALLERGIC REACTION ; ARM SWELLED AND GOT RED AND HOT
09/23/2004 - REPORTS REACTION TO TETANUS SHOT
12/03/2015 Rubelo reported

I don't want the additional text included, as this should be a date only field. How can I accomplish this? Ideally I would like it to be referenced in the datecleanup function as other functions use this as well.

The answer given by @RobHaupt on this [link](https://stackoverflow.com/questions/7929205/vba-regular-expression-to-match-date) gave the correct result on your three examples. `=FormatOutput("07/06/1993 - HAD ALLERGIC REACTION ; ARM SWELLED AND GOT RED AND HOT")` returned `34127` - 7th June 1993 (I'm in UK - so is dd/mm/yyyy format). Just change the function name as required, I'd also be more specific about the variable types than his answer... but it works. — Darren Bartrup-Cook, May 18 '18 at 15:20
To add to the link given in my last comment - I'd also add `Else: FormatOutput = CVErr(xlValue)` as the next two lines after the `Exit For` statement - this will then return `#Value!` instead of 0 for non-dates. — Darren Bartrup-Cook, May 18 '18 at 15:26
Thanks for the link provided. I'm struggling as how to incorporate this into my existing datecleanup function (if possible). I appreciate any assistance. — Nick, May 18 '18 at 15:31
By the looks of it you just need to change `Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)` to `Worksheets("CI").Range("E" & j).Value = FormatOutput(strDate)` - or change the `FormatOutput` function name to `datecleanup`. — Darren Bartrup-Cook, May 18 '18 at 15:40
I am getting a Type mismatch run-time error. My strDate global variable is defined as a Variant. Also can I leave the CreateObject("vbscript.regexp) as is? Thanks again. — Nick, May 18 '18 at 15:51

score 1 · Answer 1 · answered May 18 '18 at 20:07

Taking Nathan's and expanding on it in case of text before date:

Function dateclean(strInput As String) As String
    Dim strSplits As Variant, i As Integer, dateFound As String
    strSplits = Split(strInput, Chr(32))
    For i = 0 To UBound(strSplits)
        If strSplits(i) Like "*/*/*" Then
            dateFound = strSplits(i)
            Exit For
        End If
    Next i
    dateclean = dateFound
End Function

score 0 · Answer 2 · answered May 18 '18 at 15:00

0

Something like this

function dateclean(strInput as string) as string
     dateclean=split(strInput,chr(32))(0)
end function

answered May 18 '18 at 15:00

Nathan_Sav

8,466
2
13
20

But I don't care about the text at all, I only want the date. – Nick May 18 '18 at 15:06
Have you tried what I posted on one of your examples? – Nathan_Sav May 18 '18 at 15:07
I'm trying to figure out how I can add your code to the above datecleanup function, any suggestions? – Nick May 18 '18 at 15:11
maybe `if inputdate like "*/*/*" then` – Nathan_Sav May 18 '18 at 15:13
This seems to work good, unless there is text before the date. Any suggestions for handling that? – Nick May 18 '18 at 16:39
Look at regular expressions, or looping the array returned from `split(strInput,chr(32))` and using the `isdate` function on each element – Nathan_Sav May 21 '18 at 10:03

score 0 · Answer 3 · answered May 18 '18 at 16:14

Not sure what all your code is meant to be doing - it doesn't say where lstRow is defined.

This sample has your examples in the range Data!D2:D4.
The output will appear in the range CI!D2:D4.

Note - I've updated some variable names (although they're not used).
E.g. It's a bit more obvious what CI_LastRow contains, rather than figuring out what j stands for.

Sub Test()

    TetanusLoad 4, 5

End Sub

Public Sub TetanusLoad(col As Long, col2 As Long)

    Dim CI_LastRow As Long, Error_LastRow As Long
    Dim Data_Range As Range, rCell As Range

    CI_LastRow = Worksheets("CI").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Error_LastRow = Worksheets("Error").Cells(Rows.Count, 1).End(xlUp).Row + 1

    'This is the range containing your date/text strings.
    With Worksheets("Data")
        Set Data_Range = .Range(.Cells(1, col), .Cells(.Rows.Count, col).End(xlUp))
    End With

    For Each rCell In Data_Range
        Worksheets("CI").Cells(rCell.Row, 5) = datecleanup(rCell)
    Next rCell

End Sub

Function datecleanup(inputdate As Variant) As Variant
    Dim re, match
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
    re.Global = True

    For Each match In re.Execute(inputdate)
        If IsDate(match.Value) Then
            datecleanup = CDate(match.Value)
            Exit For
        End If
    Next
    Set re = Nothing

End Function

The datecleanup function is a copy of the FormatOutput function found on this link:
VBA Regular Expression to Match Date

VBA date clean up

3 Answers3