Search routine needs a little work
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
--
HTH...
Jim Thomlinson
" wrote:
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
|