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