vb code help with date format
"Tom Ogilvy" wrote:
14March2001
doesn't match
MyDate = Format(Date, "dd mmmm yyyy")
example:
dt = DateValue("03/14/2001")
? Format(dt, "dd mmmm yyyy")
14 March 2001
Are you sure your dates in the worksheet are stored as excel dates and not
Text values?
Why do you have wks1 and wks2 both pointing to Database - if that's what you
want, fine, but it appears suspect.
Also, Find can be a bit finicky with dates. You might experiment with the
command and target in isolation and find the most dependable combination of
of settings.
--
Regards,
Tom Ogilvy
"Anthony" wrote in message
...
I can't get my macro to respond with any data.
Column A in "database" worksheet is formatted Date: Type: 14March2001 UK
style
So why will this code, which is supposed to search that column for any
data
with today's date and cop/paste it to other cells, return the MsgBox "No
entries made in the database for today " all the time.
It must be something to do with the date search and the incorrect format -
but as I'm a novice here I don't know where it's going wrong.
Here's the code
Sub addhoc_call_log_View_todays_entries() ' First Box, 2nd macro
Sheets("Adhoc").Unprotect
Dim i As Integer
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFirst As Range
Dim rngDestination As Range
Dim rngAllRecords As Range
Dim wks1 As Worksheet, wks2 As Worksheet
Dim MyDate As Variant
Application.ScreenUpdating = False
Columns("H:T").EntireColumn.Hidden = False
Columns("F:I").EntireColumn.Hidden = True
Columns("O:AC").EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 2
Sheets("database").Range("G2:K100").ClearContents
Set wks1 = ThisWorkbook.Worksheets("database")
Set wks2 = ThisWorkbook.Worksheets("database")
On Error Resume Next
Set rngToSearch = wks1.Columns("A")
Set rngDestination = wks2.Cells(Rows.Count, "A").End(xlUp).Offset(1,
0)
MyDate = Format(Date, "dd mmmm yyyy")
Set rngFound = rngToSearch.Find(What:=MyDate, _
LookIn:=xlValues, _
LookAt:=xlWhole)
Set rngFound = rngToSearch.Find(What:=Date, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rngFound Is Nothing Then
If rngFound Is Nothing Then
MsgBox "No entries made in the database for today "
Else
On Error GoTo err_handler
lngNextRow = 2
Set rngFirst = rngFound
Set rngAllRecords = rngFound
Do
Set rngAllRecords = Union(rngAllRecords, rngFound)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
'rngAllRecords.EntireRow.Copy rngDestination.EntireRow
For Each c In rngAllRecords
wks1.Range(wks1.Cells(c.Row, "a"), wks1.Cells(c.Row,
"g")).Copy
wks1.Range(wks1.Cells(lngNextRow, "g"), wks1.Cells(lngNextRow, "M"))
lngNextRow = lngNextRow + 1
Next
'wks3.PrintOut
Sheets("Adhoc").Select
End If
Exit Sub
err_handler:
MsgBox Error, , "Err " & Err.Number
Sheets("Adhoc").Protect
End If
End Sub
Thanks for helping
|