Search routine needs a little work

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

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


"[email protected]" 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
>
>

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


Jim Thomlinson wrote:
> 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
>
>
> "[email protected]" 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
> >
> >