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.