VBA learner ITG
Active Member
- Joined
- Apr 18, 2017
- Messages
- 272
- Office Version
- 365
- Platform
- Windows
- MacOS
Hi all,
I was wondering if i could get your guidance on the below line of code.
'DATE COLUMN
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
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