Using InputBox entry with .find 1

[THarte]

XL2000

In my code I am getting data from an input box (Policy Number) and in a later routine I search all the records for specific policy numbers to update records. If I have multiple polcy numbers in a column from top to bottom say 12345, 1234, 123 and the User enters 123 in the Input Box I am getting the 12345 (first record with 123 in it) returned.

I cannot figure out the code to get the Exact matching record.

Here is the code I have:
Do
With worksheets(2).Range("J:J", "L:L&quot
sPolNum = InputBox(Prompt:="Enter Policy Number or Last Name:&quot
Sheets(2).Select
Set oPolNum = .Find(sPolNum)
If Not oPolNum Is Nothing Then
Sfound = oPolNum.Address
If Range(Sfound).Offset(0, 22).Value = "" Then
Sheets(2).Range("AZ1&quot.Value = Sfound
Range(Sfound).EntireRow.Copy
Sheets(3).Select
Cells(65536, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Cells(65536, 1).End(xlUp).Offset(1, 0).Select
Else: sPolNum = InputBox(Prompt:="There are no active Calls with the requested Policy Number. Please Try Again:&quot
End If
End If
End With


Any help is appreciated.

 

[THarte]

We have a WINNER! I am sincerely grateful for all your help. Maybe one day when I join the Guru ranks, I can return the favor.

Tony Harte

 

[xlbo]

Tony - being as various people have (from what I can see) helped you out enormously, perhaps you should give them thanks by utilising the "Click here to mark this post as a helpful or expert post" - not only is it the recognised way of saying thanks but it also points other people towards threads with good conclusions and useful advice
Rgds
Geoff

 

[THarte]

Geoff,

Thanks for pointing out that feature of the Forum and I have done as you suggested.

 

[THarte]

rmikesmith,

Not sure if you will see this or if I should start a new thread but I ran into a functionality gap that I cannot figure out. Sometimes I get multiple records with the same policy number or last name. I cannot figure out where to loop the code above to capture subsequent records. I have tried a number of different things like trying to loop and write the next record one row down from the previous record but I cannot seem to pickup the second occurrence of the policy number/last name. I have a bloody forehead and a cracked monitor right now.

Thanks
TH

 

[rmikesmith]

THarte,

Below is the updated procedure to do what you asked. Changes are in red.

Sub CommandButton2_Click()
Dim sPolNum As String
Dim wks2 As Worksheet
Dim wks3 As Worksheet
Dim Result As Variant
Dim LastEntryAddress As String
Dim LookupRange As String
Dim MatchRange As Range
Dim SaveRowNum As Long

Dim AbsRow As Long

Set wks2 = Worksheets("Sheet2")
Set wks3 = Worksheets("Sheet3")

Do
  sPolNum = InputBox(Prompt:="Enter Policy Number or Last Name:")
  If sPolNum = "" Then Exit Sub
                      
  LastEntryAddress = ActiveSheet.Cells(65536, 10).End(xlUp).Address
  LookupRange = "$J$1:" & LastEntryAddress
  Set MatchRange = wks2.Range(LookupRange)
  Result = Application.Match(sPolNum, MatchRange, 0)
  If IsError(Result) Then
    LastEntryAddress = ActiveSheet.Cells(65536, 12).End(xlUp).Address
    LookupRange = "$L$1:" & LastEntryAddress
    Set MatchRange = wks2.Range(LookupRange)
    Result = Application.Match(sPolNum, MatchRange, 0)
  End If

  If Not IsError(Result) Then

AbsRow = MatchRange.Offset(Result - 1, 0).Row

If Not IsDate(wks2.Cells(AbsRow, 32)) Then

Do

wks2.Rows(AbsRow).Copy
        wks3.Select
        Cells(65536, 1).End(xlUp).Offset(2, 0).Select
        SaveRowNum = Selection.Row
        ActiveSheet.Paste
       ' Manipulate "Sheet3" cells here
  
       'Replace "Sheet2" Row with updates
        wks3.Rows(SaveRowNum).Copy
        wks2.Cells(AbsRow, 1).PasteSpecial
        Application.CutCopyMode = False

If InStr(1, LookupRange, "B", vbTextCompare) > 0 Then
          LookupRange = "$J$" & AbsRow + 1 & ":" & LastEntryAddress
        Else
          LookupRange = "$L$" & AbsRow + 1 & ":" & LastEntryAddress
        End If
        Set MatchRange = wks2.Range(LookupRange)
        Result = Application.Match(sPolNum, MatchRange, 0)
        If Not IsError(Result) Then
          AbsRow = MatchRange.Offset(Result - 1, 0).Row
        End If
      Loop Until IsError(Result)

sPolNum = ""    'Note: this statement moved from previous version
    Else
      MsgBox "Completed records cannot be changed!", vbExclamation + vbOKOnly, "Select Policy Number/Name"
    End If
  Else
    MsgBox "No match found.", vbOKOnly + vbExclamation, "Select Policy Number/Name"
    '*** or ***
    Result = InputBox(Prompt:="No match found.  Try again:")
  End If
Loop Until sPolNum = ""

End Sub

(PS Check the specific column references since my test workbook doesn't use the same columns as your app and I may not have translated them all correctly).
Let me know if this works OK for you.

Mike

 

[rmikesmith]

THarte,

As predicted...

This line:

If InStr(1, LookupRange, "B", vbTextCompare) > 0 Then

should read:

If InStr(1, LookupRange, "

J

", vbTextCompare) > 0 Then

Sorry for any confusion

Mike