简体   繁体   中英

Date format issue on excel

Hi I have a problem with a macro which copies information from one workbook and paste it into another. Then it creates two columns and fill them with an IF formula to compare two dates. Those formulas bring the wrong result as one of the columns have another date format, and I can't change it, whatever I do on the cell is not working, only if I erase the value on any cell of that column and write a date I can change the format.

The main format needed is YYYY-MM-DD, but this column is set as dd/mm/yyyy, even if I update the cell and set it as date or custom it doesn't work at all, it keeps showing the wrong format.

This is the macro I work on, is there any way to solve this issue?

Thank you in advance.

    Sub AD_Audit()

'Last cell in column
Dim ws As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Dim wb3 As Workbook

Set ws = Worksheets(2)
With ws
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With

Dim Wb As Workbook, wb2 As Workbook
Dim vFile As Variant

'Set source workbook
Set Wb = ActiveWorkbook

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set selectedworkbook
Set wb2 = ActiveWorkbook

'Select cells to copy
wb2.Worksheets(2).Range("A1:BD" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row).Select
Selection.Copy

'Go back to original workbook you want to paste into
Wb.Activate

'Paste starting at the last empty row
Wb.Worksheets(2).Activate
Wb.Worksheets(2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Application.CutCopyMode = False
Application.ScreenUpdating = True

Dim LstrDate As String
Dim LDate As Date

LstrDate = "Apr 6, 2003"
LDate = CDate(LstrDate)

'search for columns containing the data needed
Dim x As Integer
Dim lastRow As Long
lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


Dim rFind As Range
With Range("A:DB")
        Set rFind = .Find(What:="Account Last Updated", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
End If
End With

 Dim rFind1 As Range

    With Range("A:DB")
        Set rFind1 = .Find(What:="Termination Date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind1 Is Nothing Then

        End If
    End With

    Dim rFind2 As Range

    With Range("A:DB")
        Set rFind2 = .Find(What:="Last Password set date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind2 Is Nothing Then
        End If
    End With

'create columns and fill them with formulas
x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Account last updated after termination"
intcounter = 2
While (intcounter <= lastRow)
    ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""disabled"")"
    intcounter = intcounter + 1
Wend


x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Password After Termination"
intcounter = 2
While (intcounter <= lastRow)
    ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind2.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""old"")"
    intcounter = intcounter + 1
Wend

'add column Actions
Worksheets(2).Range("A1").EntireColumn.Insert
Worksheets(2).Range("A1").Formula = "Actions"

'Set headers to bold text
Rows(1).Font.Bold = True


'check for filter, turn on if none exists
  If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1:BD1").AutoFilter
  End If
  Dim Notes As Object, Maildb As Object, workspace As Object, UIdoc As Object, UserName As String
Dim MailDbName As String

ThisWorkbook.Activate
For Each Wb In Workbooks
     If Not (Wb Is ActiveWorkbook) Then Wb.Close savechanges:=False
Next


End Sub

Date values are stored in a worksheet cell as a numerical value so different formats can be applied to different cells and still retain the ability to compare (or add, subtract, etc). The formula you're applied to each cell is forcing a comparison in a specific text format when the actual value.

The key is to set your formula up to use the address of the cell, not the cell contents.

So your cell formula can simply be:

ActiveSheet.Cells(intcounter, x + 1).Formula = "=If(" & Cells(intcounter, rFind.Column).Address & ">=" & Cells(intcounter, rFind1.Column).Address & ","""review""","""disabled""")"

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM