About Us

Anthony

Thanks Dave - that worked fine

"Dave Peterson" wrote:

Maybe just add this kind of thing near the top:

If Time < TimeSerial(22, 0, 0) Then
MsgBox "It's too early!"
Exit Sub
End If

Or....

If (Time TimeSerial(4, 0, 0)) _
And (Time < TimeSerial(22, 0, 0)) Then
MsgBox "It's too early!"
Exit Sub
End If

If you want to allow from 10PM to 4AM.

Anthony wrote:

Hi 'Experts'

I was given the following code several weeks back and it works fine.
Basicaly once a macro button is selected the code will add all the data on a
worksheet to a 'database',(another worksheet)
Can somebody show me (as I am the novice) how to change this code so that
once the macro button is selected a 'time' check is made so that no data will
be added to the database before - lets say 10pm.
If the user selects this macro and the time IS before 10pm a msg box pops up
advising so, or if after 10pm all the jobs are added.
Hope that souns ok, and hope you can help.
here is the code (donated and tweeked a little)

Sub add_Anydays_jobs()

Dim DataWks As Worksheet
Dim LogWks As Worksheet
Dim FoundACellDiff As Boolean
Dim FoundAGroupMatch As Boolean
Dim RngToCopy As Range
Dim testRng As Range
Dim iRow As Long
Dim FirstRowToCheck As Long
Dim LastRowToCheck As Long
Dim cCol As Long
Dim cRow As Long
Dim DestCell As Range

Set DataWks = Worksheets(ActiveSheet.Name)
Set LogWks = Worksheets("Log")
Set RngToCopy = DataWks.Range("a8:n34")

With LogWks
FirstRowToCheck = 5 'headers?
LastRowToCheck = .Cells(.Rows.Count, "A").End(xlUp).Row
FoundAGroupMatch = False
For iRow = FirstRowToCheck To LastRowToCheck
'topleftcell of possible range to paste
Set testRng = .Cells(iRow, "A")
FoundACellDiff = False
For cRow = 1 To RngToCopy.Rows.Count
For cCol = 1 To RngToCopy.Columns.Count
If CStr(RngToCopy.Cells(cRow, cCol).Value) _
= CStr(testRng.Cells(cRow, cCol).Value) Then
'still the same
'so do nothing
Else
If CStr(RngToCopy.Cells(cRow, 2).Value) < "" Then
FoundACellDiff = True
End If
Exit For
End If
Next cCol
If FoundACellDiff Then
Exit For
End If
Next cRow
If FoundACellDiff = False Then
FoundAGroupMatch = True
Exit For
End If
Next iRow

If FoundAGroupMatch = True Then
MsgBox "This log has already been copied to the database",
vbExclamation
'exit sub '????
Else
'do the copy
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
DestCell.Resize(RngToCopy.Rows.Count, _
RngToCopy.Columns.Count).Value _
= RngToCopy.Value
MsgBox "All Today's Jobs Added Successfully !", vbInformation
End If
End With

End Sub

Many thanks
Anthony

--

Dave Peterson

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
split post code (zip code) out of cell that includes full address	Concord	Excel Discussion (Misc queries)	4	October 15th 09 06:59 PM
Drop Down/List w/Code and Definition, only code entered when selec	Spiritdancer	Excel Worksheet Functions	2	November 2nd 07 03:57 AM
Create a newworksheet with VBA code and put VBA code in the new worksheet module	ceshelman	Excel Programming	4	June 15th 05 04:37 PM
stubborn Excel crash when editing code with code, one solution	Brian Murphy	Excel Programming	0	February 20th 05 05:56 AM
option buttons run Click code when value is changed via VBA code	neonangel	Excel Programming	5	July 27th 04 08:32 AM

Menu

About Us