VBA date cell value formatting issue

[VBA learner ITG]

Hi all,

I was wondering if i could get your guidance on the below line of code.

'DATE COLUMN

ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Or InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Then
            ' this needs to be text value cell but showing date
            FDWS.Columns(DestCol).NumberFormat = "dd/mm/yyyy;@"

I need the cell value to be a date value but in a true text format cell.

I believe the line of code is correct, but when it goes through another solution its reading the date value as a numerical value.

Can anyone advise what i am doing wrong?



--------------------------------------------------------------------------------------------------------------------------
Full Code below

Private Function DoFusion(supermarket As Boolean, ByRef FDWS As Worksheet)
Dim FIWS As Worksheet
Dim FDLastCol As Long, FDLastRow As Long, FILastRow As Long, FILastCol As Long
Dim SrcCol As Long, DestCol As Long, DestRow As Long
Dim NewWB As Workbook, ControlWB As Workbook
Dim NewWS As Worksheet
Dim OutputFilename As String

    If supermarket Then
        OutputFilename = "Supermarket Fusion Data Export"
    Else
        OutputFilename = "Convenience Fusion Data Export"
    End If
    If bIsBookOpen(OutputFilename & ".xlsx") Then
        MsgBox "Please close the existing " & OutputFilename & ".xlsx file"
        Exit Function
    End If
        
    Application.ScreenUpdating = False
    
    Set ControlWB = ActiveWorkbook
    Set FIWS = Worksheets("FUSION_INTERMEDIATE")
    FDLastCol = FDWS.Cells(1, FDWS.Columns.Count).End(xlToLeft).Column
    ' column headings in row 3
    FILastCol = FIWS.Cells(3, FIWS.Columns.Count).End(xlToLeft).Column
    FILastRow = FIWS.Cells(FIWS.Rows.Count, "A").End(xlUp).Row
    FDLastRow = FDWS.Cells(FDWS.Rows.Count, FDLastCol).End(xlUp).Row
    ' clear out current data
    If FDLastRow > 1 Then
        FDWS.Range(FDWS.Cells(2, 1), FDWS.Cells(FDLastRow, FDLastCol)).ClearContents
    End If
    
    ' filter for sequence 1
    FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=2, Criteria1:="1"
    ' and appropriate non-blanks
    If supermarket Then
        FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=24, Criteria1:="<>"
    Else
        FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=23, Criteria1:="<>"
    End If
    
    For DestCol = 1 To FDLastCol
        ' find corresponding src column
        For SrcCol = 1 To FILastCol
            If Trim(UCase(FIWS.Cells(3, SrcCol).Value)) = Trim(UCase(FDWS.Cells(1, DestCol).Value)) Then
                FIWS.Range(FIWS.Cells(3, SrcCol), FIWS.Cells(FILastRow, SrcCol)).SpecialCells(xlCellTypeVisible).Copy
                FDWS.Cells(1, DestCol).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Exit For
            End If
        Next SrcCol
    Next DestCol

    ' clear filters
    FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=2
    If supermarket Then
        FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=24
    Else
        FIWS.Range("$A$3:$BN$" & FILastRow).AutoFilter Field:=23
    End If
    
    ' now apply the tidying up rules
    FDWS.Cells.Replace What:="£", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    For DestCol = 1 To FDLastCol
        If Trim(LCase(FDWS.Cells(1, DestCol).Value)) = "offer_type" Then
            ' make lower case
        ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "pricing") > 0 Or InStr(LCase(FDWS.Cells(1, DestCol).Value), "price") > 0 Then
            ' 2 decimal points
            FDWS.Columns(DestCol).NumberFormat = "0.00"
        'DATE COLUMN
        ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Or InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Then
            ' this needs to be text value cell but showing date
            FDWS.Columns(DestCol).NumberFormat = "dd/mm/yyyy;@"
        ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "bleed_code") > 0 Then
            FDLastRow = FDWS.Cells(FDWS.Rows.Count, DestCol).End(xlUp).Row
            For DestRow = 2 To FDLastRow
                If supermarket Then
                    FDWS.Cells(DestRow, DestCol).Value = Format(DestRow - 1, "0000") & "-" & Trim(FDWS.Cells(DestRow, DestCol).Value) & "S-"
                Else
                    FDWS.Cells(DestRow, DestCol).Value = Format(DestRow - 1, "0000") & "-" & Trim(FDWS.Cells(DestRow, DestCol).Value) & "C-"
                End If
            Next DestRow
        End If
    Next DestCol
    Application.DisplayAlerts = False
    FDWS.Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
        
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True

    ' copy sheet to new workbook
    FDWS.Copy
    Set NewWS = ActiveSheet
    Set NewWB = ActiveWorkbook
    ' rename the pricing column
    NewWS.Cells.Replace What:="supermarket_group_pricing", Replacement:="group_pricing", LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
    NewWS.Cells.Replace What:="convenience_group_pricing", Replacement:="group_pricing", LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
    
    ' just overwrite
    Application.DisplayAlerts = False
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' windows needs the file extension
        NewWB.SaveAs ControlWB.Path & Application.PathSeparator & OutputFilename & ".xlsx"
    Else
        ' mac doesn't want it
        NewWB.SaveAs ControlWB.Path & Application.PathSeparator & OutputFilename, FileFormat:=52
    End If
    Application.DisplayAlerts = True
            
End Function

 

[Joe4]

I need the cell value to be a date value but in a true text format cell.

I believe the line of code is correct, but when it goes through another solution its reading the date value as a numerical value.

I am not quite clear on what you mean by "date value but in a true text format". Can you show us a few examples?

Also note, that dates in Excel are actually stored as numbers, specifically the number of days since 1/0/1900.
So, if you have a valid date entry in a cell, but do not apply a date format to it, it will appear as a large integer.

 

[VBA learner ITG]

Hi Joe4,

Thank you for the reply.

You are correct as the code converts the date column into an excel date format dd/mm/yyyy from a numerical value.

The issue I have is when its imported into another solution it converts this date column into a text column and it doesn't retain the date format and reverts the value back to the numerical value.

Is there a way to make this date column a text column but showing the date as dd/mm/yyyy?

 

[Joe4]

The issue I have is when its imported into another solution it converts this date column into a text column and it doesn't retain the date format and reverts the value back to the numerical value.

What other program is it being imported into?

Note that you can use the "FORMAT" function in VBA to convert it to a string. It would look like:
FORMAT(your value,"dd/mm/yyyy")

 

[VBA learner ITG]

The programme the worksheet is going into is an in house built system.
From my understanding the solution is copying and pasting the excel values into a text value document.

 

[Joe4]

The programme the worksheet is going into is an in house built system.
From my understanding the solution is copying and pasting the excel values into a text value document.

See if applying the FORMAT function in VBA will work for you.
The FORMAT function returns text values (it works similarly to the Excel "TEXT" function).

 

[VBA learner ITG]

I have tried amending the code from

ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Or InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Then
            ' this needs to be text value cell but showing date
            FDWS.Columns(DestCol).NumberFormat = "dd/mm/yyyy;@"

to the below:

ElseIf InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Or InStr(LCase(FDWS.Cells(1, DestCol).Value), "end_date") > 0 Then
            ' this needs to be text value cell but showing date
            FDWS.Columns(DestCol) =format("end_date","dd/mm/yyyy")

However, im getting the whole date column prefilled with a date and not where there is a value.

Apologies, i have been staring at this code for a while and my mind if turning into mush.

 

[Joe4]

The part in red is incorrect.

format("end_date","dd/mm/yyyy")

You are trying to format the literal text value "end_date", which makes no sense.
You want to format the value, not the phrase "end_date".

Note that while you can format a whole column at once, you cannot apply the FORMAT function to the whole column at once.
You will need to loop through the range and apply the function to each value, one at a time.