Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
vb code help with date format
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Code to conditional format all black after date specified in code? | Excel Discussion (Misc queries) | |||
Code Date Format Depending on Computer format | Excel Discussion (Misc queries) | |||
date format in code | Excel Discussion (Misc queries) | |||
code to convert date from TEXT format (03-02) to DATE format (200203) | Excel Programming | |||
code pasting a date changes date format in current month only | Excel Programming |