This event code is giving me fits.

If I change B5 it does its work just fine.
Then if I change J5 it does its work and sends B5's called code into a continual loop for about 20 reps then errors out and the workbook freezes up.

Close, reopen repeat. Freeze.

I have used a few other exclusion lines from a googled site to be sure I had all the correct syntax but this is not working out.

I want make an entry in either B5 or J5 and run two different codes.

If I put each code on a separate button, both work just fine.

thanks,
Howard

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B5,J5")) Is Nothing Then

If Target.Count 1 Then Exit Sub

If Target = Range("B5") Then
Scan_In_Check
End If

If Target = Range("J5") Then
Scan_Out_Check
End If

End If
End Sub

Hi Howard,

Am Thu, 29 May 2014 23:15:26 -0700 (PDT) schrieb L. Howard:

Then if I change J5 it does its work and sends B5's called code into a continual loop for about 20 reps then errors out and the workbook freezes up.

try:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B5,J5")) Is Nothing Then

If Target.Count 1 Then Exit Sub

Application.EnableEvents = False
On Error GoTo EventsOn

If Target = Range("B5") Then
Scan_In_Check
End If

If Target = Range("J5") Then
Scan_Out_Check
End If

End If

EventsOn:
Application.EnableEvents = True
End Sub

If this does not solve the problem please post "Scan_In_Check" and
"Scan_Out_Check"


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

If this does not solve the problem please post "Scan_In_Check" and

"Scan_Out_Check"


Regards

Claus B.

--

Hi Claus,

That did solve the problem. I did try an error capture routine from that same site I mentioned, but must have misapplied it.
This works just fine and I thank you.

Howard

Another way...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5,J5")) Is Nothing Then Exit Sub
If Target.Count = 1 Then
Application.EnableEvents = False
On Error Resume Next
Select Case Target.Address
Case "$B$5": Call Scan_In_Check
Case "$J$5": Call Scan_Out_Check
End Select
Application.EnableEvents = True
End If
End Sub

Sub Scan_In_Check()
MsgBox "B5 changed!"
End Sub

Sub Scan_Out_Check()
MsgBox "J5 changed!"
End Sub

...depending, of course, on what those called procedures do.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Note that the "If Target.Count..." line really isn't needed since the
select case criteria are single cells...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5,J5")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
Select Case Target.Address
Case "$B$5": Scan_In_Check
Case "$J$5": Scan_Out_Check
End Select
Application.EnableEvents = True
End Sub

...and so will not match if a range of cells are changed.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Friday, May 30, 2014 9:21:04 AM UTC-7, GS wrote:
Another way...



Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B5,J5")) Is Nothing Then Exit Sub

If Target.Count = 1 Then

Application.EnableEvents = False

On Error Resume Next

Select Case Target.Address

Case "$B$5": Call Scan_In_Check

Case "$J$5": Call Scan_Out_Check

End Select

Application.EnableEvents = True

End If

End Sub



Sub Scan_In_Check()

MsgBox "B5 changed!"

End Sub



Sub Scan_Out_Check()

MsgBox "J5 changed!"

End Sub



..depending, of course, on what those called procedures do.



--

Garry


Hi Garry,

That works well and also did away with a pesky little item that lingered with Claus' solution.

The Scan In macro takes the input from B5 and searches a list on another sheet and returns data to an "In" list.

The Scan Out takes the input from J5 and looks at the "In" list and removes elements from it to an "Out" list.

The pesky problem was if the search string was the same in B5 & J5, then when either B5 or J5 produced the change_event both called macros would run.

I cannot reproduce that scenario with your solution in the many test I given it.

So, my next step is to time stamp the identical info returned to the "In" & "Out" lists but do it on sheets named by Month of the year. So sheet named May (for the next day or so) then to sheet June after that.

I'm sensing some difficulties here as I seldom work with dates other than a time stamp. I believe there are some 'Month' function/s that I will need to look into to determine what sheet to go to.

I suppose to test for it going to July or August is to use Now() + 30 & 60 in some capacity. Need to jump in and see whats what.

Thanks for the code.

Howard

So, my next step is to time stamp the identical info returned to the
"In" & "Out" lists but do it on sheets named by Month of the year.
So sheet named May (for the next day or so) then to sheet June after
that.

I'm sensing some difficulties here as I seldom work with dates other
than a time stamp. I believe there are some 'Month' function/s that
I will need to look into to determine what sheet to go to.

I suppose to test for it going to July or August is to use Now() + 30
& 60 in some capacity. Need to jump in and see whats what.

I'm up for the easiest solution here...

Set wksTarget = Sheets(Format(Date(),"mmm")) 'Jan,Feb...
OR
Set wksTarget = Sheets(Format(Date(),"mmmm")) 'full name

...depending on what you prefer.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I'm up for the easiest solution here...



Set wksTarget = Sheets(Format(Date(),"mmm")) 'Jan,Feb...

OR

Set wksTarget = Sheets(Format(Date(),"mmmm")) 'full name



..depending on what you prefer.



So if the sheet name is Feb 14 this would work with the space after "mmm "?

Set wksTarget = Sheets(Format(Date, "mmm " & 14)) 'Feb 14

or

Set wksTarget = Sheets(Format(Date, "mmm" & " " & 14)) 'Feb 14

Howard

No! Do it this way...

Set wksTarget = Sheets(Format(Date, "mmm yy")) 'Jan,Feb...

OR

Set wksTarget = Sheets(Format(Date, "mmmm yy")) 'full name

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Just to add, all the sheets are named like Feb 14, where before the 14th of Feb the data would go on sheet Jan 14, the 14th and after on sheet Feb 14.

Bit strange to me but...

I may be able to change the sheet names to something similar but not a real date.

Howard

On Friday, May 30, 2014 7:16:05 PM UTC-7, GS wrote:
No! Do it this way...



Set wksTarget = Sheets(Format(Date, "mmm yy")) 'Jan,Feb...



OR



Set wksTarget = Sheets(Format(Date, "mmmm yy")) 'full name



--

Garry

The 14 is a day not the year. You were referring to 2014 I think.

I'm thinking name change is a good idea.

Howard

On Friday, May 30, 2014 7:17:29 PM UTC-7, L. Howard wrote:
Just to add, all the sheets are named like Feb 14, where before the 14th of Feb the data would go on sheet Jan 14, the 14th and after on sheet Feb 14.



Bit strange to me but...



I may be able to change the sheet names to something similar but not a real date.



Howard

On Friday, May 30, 2014 7:16:05 PM UTC-7, GS wrote:
No! Do it this way...



Set wksTarget = Sheets(Format(Date, "mmm yy")) 'Jan,Feb...



OR



Set wksTarget = Sheets(Format(Date, "mmmm yy")) 'full name



--

Garry

The 14 is a day not the year. You were referring to 2014 I think.

I'm thinking name change is a good idea.

Howard

So what's happening is the sheetnames reflect 'period' data. In this
case I'd go with modifying CodeName and use that so it won't matter
what the sheetname is. For example...

Sheets("Feb 14").CodeName = "wksFeb14"

...and use it like this...

<snip
Dim sName$
Const sPeriodEnd$ = "14" '//edit to suit
sName = Get_SheetTabName("wks" & Format(Date(), "mmm" & sPeriodEnd))
If sName < "" then Set wksTarget = Sheets(sName)
</snip


Function Get_SheetTabName$(CodeName$, Optional Wkb As Workbook)
Dim wks As Worksheet
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
For Each wks In Wkb.Worksheets
If wks.CodeName = CodeName Then
Get_SheetTabName = wks.name: Exit Function
End If
Next
End Function

Better alternative:
Store CodeName in a local scope defined name. This is my preference
since Excel has been known to discard user-defined values and replace
with default values after crash recovery. In this case you just pull
from wks.Names like this...

<snip
Dim sName$
Const sPeriodEnd$ = "14" '//edit to suit
sName = Get_uiCodename("wks" & Format(Date(), "mmm" & sPeriodEnd))
If sName = "" Then Exit Sub
Set wksTarget = Sheets(sName)
</snip

Function Get_uiCodename$(CodeName$, Optional Wkb As Workbook)
Dim wks As Worksheet, vTmp, sDefName$
If Wkb Is Nothing Then Set Wkb = ActiveWorkbook
On Error Resume Next '//if name doesn't exist
For Each wks In Wkb.Worksheets
sDefName = "uiCodename"
vTmp = wks.Names(sDefName).RefersTo
If Not (vTmp = Empty) Then
sDefName = "'" & wks.name & "'!" & sDefName
vTmp = Application.Evaluate(sDefName)
If (vTmp = CodeName) Then
Get_uiCodename = wks.name: Exit Function
End If '(vTmp = CodeName)
End If 'Not (vTmp = Empty)
Next
End Function

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

For clarity...

Excel has been known to discard user-defined Codename values and
replace with default Codename values after crash recovery.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Hi Garry,

Turns out the 14 is indeed 2014 and not the 14th.

Sorry, seems the scenery keeps changing on me.

I will have a much better chance to make this work than the 'period data' solution.

Set wksTarget = Sheets(Format(Date, "mmm yy")) 'Jan,Feb...

OR

Set wksTarget = Sheets(Format(Date, "mmmm yy")) 'full name


I'm still having a problem with one of the macro the change_event macro calls.
If you don't mind taking a look, here it is.

With the search string from cell sheet UI, cell B5 look in the range
Sheets("UI").Range("K18:K" & LrDBo) and if there CUT (or copy and then clearcontents) to the range in Sheets("UI").column B.

If search string is not in the column K range then go to Sheets("DATABASE").Range("B4:B" & LrDB). and if there copy to the Sheets("UI").column B.

If search string is not in either, then msgbox not found. Noting that I cannot have duplicate entries in either the sheet UI range K list or the UI range B list.

If not found in the K list it throws an object not set error. The On error resume next seems to stop that but probably can be done away with proper code??

Thanks,
Howard


Sub Scan_In_Check()

Dim scanIDIN As Range
Dim scanIDINo As Range
Dim eIDin As String
Dim eIDino As String
Dim LrDB As Long
Dim LrDBo As Long

eIDin = Sheets("UI").Cells(5, 2)

LrDBo = Sheets("UI").Cells(Rows.Count, "K").End(xlUp).Row

On Error Resume Next 'object not set error here if no match

Set scanIDIN = Sheets("UI").Range("K18:K" & LrDBo).Find(What:=eIDin, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not scanIDIN Is Nothing Then
scanIDIN.Offset(, -2).Resize(1, 3).Copy Sheets("UI").Range("B" & Rows.Count).End(xlUp)(2)
scanIDIN.Offset(, -2).Resize(1, 3).ClearContents

Else

LrDB = Sheets("DATABASE").Cells(Rows.Count, "B").End(xlUp).Row

Set scanIDIN = Sheets("DATABASE").Range("B4:B" & LrDB).Find(What:=eIDin, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not scanIDIN Is Nothing Then
Sheets("UI").Range("D" & Rows.Count).End(xlUp)(2) = scanIDIN
scanIDIN.Offset(, 2).Copy Sheets("UI").Range("B" & Rows.Count).End(xlUp)(2)
scanIDIN.Offset(, 1).Copy Sheets("UI").Range("C" & Rows.Count).End(xlUp)(2)
Else
MsgBox " No match found." & vbCr & vbCr & "Retry or investigate why."
End If
End If
End Sub

Try...

Sub Scan_In_Check()

Dim rng As Range, sID$, lLastRow&, sMsgs$
Dim wksSource As Worksheet, wksTarget As Worksheet

On Error GoTo ErrExit
Set wksSource = Sheets("UI")
With wksSource
sID = .Cells(5, 2)
lLastRow = .Cells(Rows.Count, "K").End(xlUp).Row
End With 'wksSource

Set rng = wksSource.Range("K18:K" & lLastRow).Find(What:=sID, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rng Is Nothing Then
With rng.Offset(, -2).Resize(1, 3)
.Copy Sheets("UI").Range("B" & Rows.Count).End(xlUp)(2)
.ClearContents
End With 'rng.Offset(, -2).Resize(1, 3)

Else
Set wksSource = Sheets("DATABASE")
lLastRow = wksSource.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = wksSource.Range("B4:B" & lLastRow).Find(What:=sID, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not rng Is Nothing Then
Set wksTarget = Sheets("UI")
With wksTarget
.Range("D" & Rows.Count).End(xlUp)(2) = rng
rng.Offset(, 2).Copy .Range("B" & Rows.Count).End(xlUp)(2)
rng.Offset(, 1).Copy .Range("C" & Rows.Count).End(xlUp)(2)
End With 'wksTarget
Else
sMsg = "No match found!"
sMsg = sMsg & vbLf & vbLf
sMsg = sMsg & "Retry or investigate why."
MsgBox sMsg, vbExclamation
End If 'Not rng Is Nothing
End If 'Not rng Is Nothing

ErrExit:
'Cleanup
Set rng = Nothing: Set wksSource = Nothing: Set wksTarget = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Try...
Sub Scan_In_Check()

Hi Garry,

That smoothed the wrinkles out quite nicely.

Minor typo

sMsgs$

sMsg = "No match found!"

but easily corrected.

Turns out I actually need to look at three different ranges to assure non dupes so it was pretty easy to replicate the third range code from what was already there.

On to exporting to the monthly sheets with date/time stamp.

Thanks for the great help.

Howard

Try...
Sub Scan_In_Check()

Hi Garry,

That smoothed the wrinkles out quite nicely.

Minor typo

sMsgs$

sMsg = "No match found!"

but easily corrected.

Good catch! I added that in my reply then updated the macro. Should be

sMsg$

Turns out I actually need to look at three different ranges to assure
non dupes so it was pretty easy to replicate the third range code
from what was already there.

On to exporting to the monthly sheets with date/time stamp.

Thanks for the great help.

You're welcome! Thanks for the feedback...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Almost there but now I can't figure out the last pesky problem/s.

https://www.dropbox.com/s/knm4fawt21...p%20Box.xl sm

I include a link as I doubt if I can fully explain the problem without it.

With the workbook as sent, on sheet "Jun 14" is an example of what is happening well and what is not happening well.

There are two rows that have correctly posted data with the date and time for scan in and for scan out. The next two where only are Z23 and Z24 posted, and that is where the problem in the code is.

If working correctly, on sheet UI scan in Z23 and then Z24. Columns B, C & D will display the data for Z23 and Z24. And the data will also be copied to sheet Jun 14 along with a date and time scanned in. This works.

Now scan Z23 and Z24 out in J5, Z23 and Z24 and the data on sheet UI is moved to columns I, J & K. And on sheet Jun 14 the date and time of the scan out is displayed. This works also.

Now with B5 if you scan Z23 and Z24 in again the data from I, J and K should go back to B, C and D. And the data should also display below the existing data on sheet Jun 14 along with the date and time Z23 and Z24 were re scanned in. Now it only brings the Z23 and Z24 with no data or scan in time stamp. Can't understand why this is not repeatable if it can do it one correctly but only once.

I think I also have the wrong code to place the time stamps. The time stamps need come from code that offset from the Z number and not from an ".xl(up)(2)" because there will certainly be fully occupied rows below an entry that needs a scan out date and time.

Another problem looming is if an employee scans in on one month and then scans out the next month... I have no clue how to get the scan out time stamp back to the previous month. That seems formidable to me.

Thanks for any advice or help you can offer.

Howard

It's almost as if you need a 'ScanIn2' and 'ScanOut2' to handle
rescans!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

On Sunday, June 1, 2014 10:53:13 PM UTC-7, GS wrote:
It's almost as if you need a 'ScanIn2' and 'ScanOut2' to handle

rescans!



--

Garry


Okay, that never occurred to me, I'll give it some thought. Something to take some of the load off the existing code.

Thanks, I will ponder that.

Howard