Convert SAP Date using VBA

[AndrewJRoberts]

When I export my sap reports into excel (use TAB deliminator) to change the date format from 12.03.2019 to 12/03/2019 I use the function =VALUE(SUBSTITUTE(W191,".","/")) and then format it to required format.

I want to be able to use VBA to save time
The number of columns varies for different reports
The columns where the date sits varies
the number of rows can be 1000 upto 64,000+

Any advice would be appreciated

BR
Andy

 

[pbornemeier]

I would think that SAP could be caused to export data in the desired format, but here are 2 options. The first checks each column for a date in row 2 and allows the user to choose to convert that column. The second just converts all columns that it sees as having dates. Ctrl-Z will not restore previous values. TEST ON A COPY OF YOUR DATA.

Option Explicit

Sub FixSAPDatesWithConfirm()
    'Search row 2 for values in the format ##.##.####
    'User has option to confirm replacement of . with / in that column
    
    Dim oFound As Object
    Dim sColLtr As String
    Dim sConverted As String
    Dim sSkipped As String
    
    'Note:  Selecting cells is typically a bad move, but sometimes necessary.  In this case
    'I wanted to examine the columns in order, not B to last column then A
    
    Range("A1").Select
    Do
        Set oFound = Rows("1:2").Find(What:="??.??.????", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not oFound Is Nothing Then
            Application.Goto ActiveSheet.Cells(1, oFound.Column), scroll:=True
            sColLtr = Split(Cells(1, oFound.Column).Address, "$")(1)
            If InStr(sSkipped, "." & sColLtr & ".") > 0 Then
                'Checking a column that was previously skipped,
                '  so must have checked all other already
                Exit Do
            End If
            Select Case MsgBox("Column " & sColLtr & " appears to contain SAP dates." & vbLf & vbLf & _
                "Do you want to convert to slash-dates?" & vbLf & vbLf & _
                "    Yes" & vbTab & "to convert." & vbLf & _
                "    No" & vbTab & "to skip conversion for this column." & vbLf & _
                "    Cancel" & vbTab & "to stop converting columns.", _
                vbYesNoCancel + vbDefaultButton1, _
                "Convert Column " & sColLtr & " ?")
            Case vbYes
                'Convert
                Columns(oFound.Column).Replace What:=".", Replacement:="/", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
                sConverted = sConverted & ", " & sColLtr
            Case vbNo
                'Don't convert, continue to next column
                sSkipped = sSkipped & "." & sColLtr & "."
                'ActiveCell.Offset(1, 0).Select
            Case vbCancel
                'Quit
                Exit Do
            End Select
        End If
        DoEvents
        ActiveCell.Offset(1, 0).Select
    Loop While Not Rows("2:2").FindNext(After:=ActiveCell) Is Nothing
    
    If Len(sConverted) > 0 Then
        sConverted = "The following columns were converted:" & vbLf & _
            Mid(sConverted, 2)
    Else
        sConverted = "No columns were converted"
    End If
    
    MsgBox sConverted, , "Completion Report"
    Debug.Print Now(), sConverted
    
End Sub

Sub FixSAPDatesNoConfirm()
    'Search row 2 for values in the format ##.##.####
    'In that column replace . with /
    
    Dim oFound As Object
    
    Do
        Set oFound = Rows("2:2").Find(What:="??.??.????", LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not oFound Is Nothing Then
            Columns(oFound.Column).Replace What:=".", Replacement:="/", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        End If
        DoEvents
    Loop While Not Rows("2:2").FindNext Is Nothing
    
End Sub