VBA date cell value formatting issue

VBA learner ITG

Board Regular
Joined
Apr 18, 2017
Messages
214
Office Version
  1. 365
Hi all,

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

'DATE COLUMN
VBA Code:
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

VBA Code:
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
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,915
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Apr 18, 2017
Messages
214
Office Version
  1. 365
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,915
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Apr 18, 2017
Messages
214
Office Version
  1. 365

ADVERTISEMENT

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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,915
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Apr 18, 2017
Messages
214
Office Version
  1. 365
I have tried amending the code from

VBA Code:
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:

VBA Code:
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,915
Office Version
  1. 365
Platform
  1. Windows
The part in red is incorrect.
Rich (BB code):
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,498
Messages
5,636,665
Members
416,935
Latest member
Atulcp

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
Top