Search routine needs a little work

[goss9394]

Hi all -

My search routine below
I can't seem to figure out how to add a little functionality

1. Currently finds a value and returns the value
should retrun the cell ref such as A36

2. Maybe even better, take the user to the sheet and the cell
and change the interior color of the entire row (A:V) to 36 (soft
yellow)

3. What if the number does not exist in the database?
I'm not sure what to add if the search snippet comes back empty

Thanks much
-goss

Option Explicit

Sub cm_ValidateBeforeWrite()

Dim wbBook As Workbook
Dim wsWrite As Worksheet 'RCM_Write
Dim wsData As Worksheet 'RCM_Data
Dim rngFoundCell As Range
Dim rngToSearch As Range
Dim lngValueToBeFound As Long
Dim lngRows As Long
Dim Msg As Long

With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wbBook = ThisWorkbook
Set wsWrite = wbBook.Worksheets("RCM_Write")
Set wsData = wbBook.Worksheets("RCM_Data")

'Refresh the dataset
'cm_GetData

'What to search for
lngValueToBeFound = wsWrite.Range("A2").Value

'Where to search
lngRows = wsData.Range("A65536").End(xlUp).Row
Set rngToSearch = wsData.Range("A2:A" & lngRows)

'Search
Set rngFoundCell = rngToSearch.Find(what:=lngValueToBeFound, _

after:=rngToSearch.Cells(rngToSearch.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole)
'Response
Msg = MsgBox("The RCM_Nmbr is already in use. " & vbCrLf _
& rngFoundCell & ".", vbInformation + vbOKOnly, "Message")


'//Cleanup
Set rngToSearch = Nothing
Set rngFoundCell = Nothing
Set wsData = Nothing
Set wsWrite = Nothing
Set wbBook = Nothing

With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

 

[Jim Thomlinson]

Untested but this should be close...

Option Explicit

Sub cm_ValidateBeforeWrite()

Dim wbBook As Workbook
Dim wsWrite As Worksheet 'RCM_Write
Dim wsData As Worksheet 'RCM_Data
Dim rngFoundCell As Range
Dim rngToSearch As Range
Dim lngValueToBeFound As Long

With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wbBook = ThisWorkbook
Set wsWrite = wbBook.Worksheets("RCM_Write")
Set wsData = wbBook.Worksheets("RCM_Data")

'Refresh the dataset
cm_GetData

'What to search for
lngValueToBeFound = wsWrite.Range("A2").Value

'Where to search
Set rngToSearch = wsData.columns("A")

'Search
Set rngFoundCell = rngToSearch.Find(what:=lngValueToBeFound, _

after:=rngToSearch.Cells(rngToSearch.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole)
if rngfoundcell is nothing then 'check if something was found
'Response
Msg = MsgBox("The RCM_Nmbr is already in use. " & vbCrLf _
& rngFoundCell & ".", vbInformation + vbOKOnly, "Message")
else
wsdata.select
rngfoundcell.entirerow.interior.color = 36
rngfoundcell.select
end if

'//Cleanup
Set rngToSearch = Nothing
Set rngFoundCell = Nothing
Set wsData = Nothing
Set wsWrite = Nothing
Set wbBook = Nothing

With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

 

[goss9394]

Thanks Jim
Works well.
Two minor things

-code 36 appears to be black at least the row comes back filled black
odd because I ran a little piece of code to return the color index of
the selected cell
So I filled a cell with light yellow, ran the code MsgBox came back
with 36

Any idea the correct index for light yellow or where I could look to
verify?

Thanks
-goss