Code to check existence

[Guest]

I have a long list of data consisting many columns but
Column And B are Important Column A consist of Unique
reference numbers and column B shows their status.
Statuses are CURRENT, MOVED or CLOSED. The status MOVED
can appear many times for the same URN while CURRENT or
CLOSED would appear once.

An userform is used to amend the list. I want to add a
code so when the OK button is clicked the code will check
that the URN exists and if it does then it has a status
CURRENT. If these to conditions are not met then exit sub.

Your help with the code would be appreciated. Thanks in
advance.

Regards

 

[Tom Ogilvy]

Sub AA()
Dim Urn As String, bFound As Boolean
Dim rng As Range, cell As Range
Dim rng1 As Range, fAddr As String
bFound = False
Urn = "A1234"
With Worksheets("Data")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
Set cell = rng.Find(Urn)
If Not cell Is Nothing Then
fAddr = cell
Do
If rng1 Is Nothing Then
rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
Set cell = rng.FindNext(cell)
Loop While cell.Address <> fAddr
If Not rng1 Is Nothing Then
For Each cell In rng1
If LCase(cell.Offset(0, 1).Value) = "current" Then
bFound = True
End If
Next
End If
End If
If bFound Then
MsgBox Urn & " found with current status"
Else
MsgBox Urn & " not found with current status"
End If
End Sub


Maybe the above untested code will give you some ideas.

 

[Guest]

Thanks Tom.

-----Original Message-----
Sub AA()
Dim Urn As String, bFound As Boolean
Dim rng As Range, cell As Range
Dim rng1 As Range, fAddr As String
bFound = False
Urn = "A1234"
With Worksheets("Data")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
Set cell = rng.Find(Urn)
If Not cell Is Nothing Then
fAddr = cell
Do
If rng1 Is Nothing Then
rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
Set cell = rng.FindNext(cell)
Loop While cell.Address <> fAddr
If Not rng1 Is Nothing Then
For Each cell In rng1
If LCase(cell.Offset(0, 1).Value) = "current" Then
bFound = True
End If
Next
End If
End If
If bFound Then
MsgBox Urn & " found with current status"
Else
MsgBox Urn & " not found with current status"
End If
End Sub


Maybe the above untested code will give you some ideas.

--
Regards,
Tom Ogilvy





.