I cant 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 todays 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 Im a novice here I dont know where its going wrong.

Heres 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

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

"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