Solved: Date Format

[zoom38]

I have a column of dates in the format "mm/dd/yyyy". I have vba code that retrieves a date from the user and searches the column of dates to find that date. The problem is that the date is automatically in the format "m/d/yyyy" so if the date enterred by the user is 03/05/2006, vba automatically reverts it to 3/5/2006 so my find routine doesn't work. I want to change the format of the date to "mm/dd/yyyy" without changing the system date settings. I tried the following but it doesn't work.


DDate = Cells(1, 13).Value
DDate = Format(DDate, "mm/dd/yyyy")


The following is my find routine where firstaddress ends up empty.


With Worksheets(1).Range("s1:s" & LR)
Set c = .Find(DDate, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Offset(0, 8).Address(True, False)
End If
End With


Anyone have any ideas?
Thanks
Gary

[zoom38]

I changed my computer short date settings to mm/dd/yyyy so the date is in the correct format. It seems this was not the problem. I believe my find routine is the problem. When I enter dates in january and march with single digit days, the firstaddress ends up empty when it shouldn't be. Below is the entire sub. Anyone know whats wrong? Anyone have a better routine to find the date?


Sub PrizeColumnAA()


Dim LastRow As Long
Dim FirstPrize As Long
Dim SecondPrize As Long
Dim ThirdPrize As Long
Dim FourthPrize As Long
Dim FifthPrize As Long
Dim NoPrize As Long
Dim DDate As Date
Dim Drawing As Long
Dim LR As Long
Dim r As Long

'Find The Last Used Cell In Column P
LastRow = Cells(Rows.Count, 16).End(xlUp).Row
r = 3

Do
If Cells(r, 16).Value = "1st Prize" Then
FirstPrize = FirstPrize + 1
End If

If Cells(r, 16).Value = "2nd Prize" Then
SecondPrize = SecondPrize + 1
End If

If Cells(r, 16) = "3rd Prize" Then
ThirdPrize = ThirdPrize + 1
End If

If Cells(r, 16).Value = "4th Prize" Then
FourthPrize = FourthPrize + 1
End If

If Cells(r, 16).Value = "5th Prize" Then
FifthPrize = FifthPrize + 1
End If

If Cells(r, 16).Value = "No Prize" Then
NoPrize = NoPrize + 1
End If

r = r + 1
Loop While r <= LastRow


LR = Cells(Rows.Count, 19).End(xlUp).Row

DDate = Cells(1, 13).Value
DDate = Format(DDate, "short date") '"mm/dd/yyyy")

With Worksheets(1).Range("s1:s" & LR)
Set c = .Find(DDate, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Offset(0, 8).Address(True, False)
End If
End With

If NoPrize = LastRow - 2 Then
Range(firstaddress).Value = "No Prize"
ElseIf FirstPrize > 0 Then
Range(firstaddress).Value = "1st Prize"
ElseIf SecondPrize > 0 Then
Range(firstaddress).Value = "2nd Prize"
ElseIf ThirdPrize > 0 Then
Range(firstaddress).Value = "3rd Prize"
ElseIf FourthPrize > 0 Then
Range(firstaddress).Value = "4th Prize"
ElseIf FifthPrize > 0 Then
Range(firstaddress).Value = "5th Prize"
End If
End Sub



Thanks
Gary

[lucas]

I want to change the format of the date to "mm/dd/yyyy" without changing the system date settings.

I changed my computer short date settings to mm/dd/yyyy so the date is in the correct format.
I don't understand. Are you resetting your entire computer date format to try to make an adjustment?

Looks like you could just format the column to match what the code is doing.

[zoom38]

Lucas, yes I changed the system regional "short date" setting to "mm/dd/yyyy" from "m/dd/yyyy". I want to keep all the dates in the "mm/dd/yyyy" format which the column with the dates are. Although I think this did play a small role, my main problem is the find routine but I don't know why. I replaced the find routine with the following 3 lines:


DDate = Format(DDate, "mm/dd/yyyy")

Drawing = Application.WorksheetFunction.Match((DDate), (Range("s2:s" & LR + 1)), 1)
firstaddress = Range("s" & Drawing + 1).Offset(0, 8).Address


I tested alot of dates and have not run into any problems. Hopefully I solved the problem.

Thanks
Gary

[Charlize]

DDate = Cells(1, 13).Value
DDate = Format(DDate, "mm/dd/yyyy")


The following is my find routine where firstaddress ends up empty.


With Worksheets(1).Range("s1:s" & LR)
Set c = .Find(DDate, LookIn:=xlValues)
'change xlValues in XlFormulas
If Not c Is Nothing Then
firstaddress = c.Offset(0, 8).Address(True, False)
End If
End With


Anyone have any ideas?
Thanks
Gary

Take in account that search will begin on row 2 and not one (strange but true). Try next routine and put some dates in column A and search for date in row one (and you have added the same date a couple of times in the rows beneath). You will probably see that row 1 is added as the last one instead of the first ??? Why ??? I wouldn't know ...
Sub find_dates()
Dim rng As Range, result As Range
Dim firstaddress As String, vmessage As String
Dim lrow As Long
Dim ddate As Date
'short or long date it shouldn't make any difference
ddate = InputBox("Give me a date", "Give date to search")
lrow = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
Set rng = Worksheets(1).Range("A1:A" & lrow)
vmessage = "Date " & ddate & " was found on rows :" & vbCrLf
With rng
Set result = .Find(ddate, LookIn:=xlFormulas)
If Not result Is Nothing Then
firstaddress = result.Address
Do
vmessage = vmessage & "- " & result.Row & vbCrLf
Set result = .FindNext(result)
Loop While Not result Is Nothing And result.Address <> firstaddress
End If
End With
MsgBox vmessage, vbInformation, "Requested info ..."
End Sub
Charlize