I'm sure this is easy but i can't do it...

[ian123]

I'm sure this is really simple but i'm a basic user and after hours o
trying i still can't do it...

How can I create a formula or macro that will search all of the cell
containing an entry and if it finds the value "PY" it will return
message (example PY = Previous Year)?

Please help!!

 

[J.E. McGimpsey]

One way:

Dim found As Range
Set found = Cells.Find("PY")
If Not found Is Nothing Then _
MsgBox """PY"" found in cell " & found.Address(False, False)

 

[ian123]

Thanks very much for your help. Instead of returning the result in
message box is it possible to return the result in a cell? Thank
again, your help really is appreciated

 

[J.E. McGimpsey]

Substitute

Range("A1").Value = """PY"" found in cell " & _
found.Address(False, False)

instead of

MsgBox """PY"" found in cell " & found.Address(False, False)

 

[index]

Excellent, thanks very much. Can you tell me how i can change th
result from "PY found in cell..." to a straight forward text entry o
"PY found".

And is it possible to return this to the active cell rather than A1?

Please excuse me if this is very simple... so am I!!!

Once again, thanks very muc

 

[Brian Pruitt]

This may be overkill, but I have a form that allows you to enter the string
to search for and then lists all occurences in a listbox.

Here is the code from the form. There are a few other modules that help
support the form. If you would like, I can email you an Excel 2000 file with
the code.

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmFindAll
Caption = "Search"
ClientHeight = 6495
ClientLeft = 45
ClientTop = 330
ClientWidth = 7905
OleObjectBlob = "frmFindAll.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "frmFindAll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cbClose_Click()
Unload frmFindAll
End Sub

Private Sub cbColorPicker_Click()
UserColor = GetAColor()
If UserColor <> False Then
tbSearchItem.BackColor = UserColor
End If
End Sub

Private Sub cbSet_Click()
On Error Resume Next
Call cbReset_Click

Call FindIt
tbSearchItem.SetFocus
End Sub

Private Sub cbReset_Click()
Dim ws As Worksheet
For i = 0 To lbResults.ListCount - 2
SheetName = lbResults.List(i, 3)
Set ws = ActiveWorkbook.Sheets(SheetName)

Addr = lbResults.List(i, 2)
ws.Range(Addr).Interior.Color = lbResults.List(i, 1)
Next
lblTotal.Caption = "Total found: 0"
lbResults.Clear

End Sub

Private Sub cbSave_Click()
Dim newsheetname As String
Application.ScreenUpdating = False
xyz = 0
newsheetname = "Search Results"
redo:
e = SheetExists(newsheetname)
If e = True Then
xyz = xyz + 1
newsheetname = "Search Results" & xyz
GoTo redo
Else
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = newsheetname
For i = 0 To lbResults.ListCount - 1
ActiveCell.Value = lbResults.List(i, 0)
ActiveCell.Offset(0, 1).Value = lbResults.List(i, 1)
ActiveCell.Offset(0, 2).Value = lbResults.List(i, 2)
ActiveCell.Offset(0, 3).Value = lbResults.List(i, 3)

ActiveCell.Offset(1, 0).Select
Next i
End If

Cells.Select
Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True
End Sub

Private Sub cboxlist_Change()
tbSearchItem.SetFocus
End Sub

Private Sub lbResults_Click()
Dim ws As Worksheet
On Error Resume Next
SheetName = lbResults.List(i, 3)
Set ws = ActiveWorkbook.Sheets(SheetName)

X = lbResults.ListIndex
Addr = lbResults.List(i, 2)
ws.Range(Addr).Interior.Color = lbResults.List(i, 1)
ws.Activate
ActiveSheet.Range(lbResults.List(X, 2)).Select
End Sub

Sub FindIt()
Dim MyArray()
Dim Count As Integer
Dim sh As Worksheet
Count = GetCount(tbSearchItem.Text)
ReDim MyArray(Count, 3)
Row = 0
If tbSearchItem.Text = "" Then Exit Sub
shname = cboxList.List(cboxList.ListIndex, 0)
Set sh = ActiveWorkbook.Sheets(shname)
With sh.Range("a:iv")
Set c = .Find(tbSearchItem.Text, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
MyArray(Row, 0) = c.Value
MyArray(Row, 1) = c.Interior.Color
MyArray(Row, 2) = c.Address
cb1 = cboxList.ListIndex
MyArray(Row, 3) = cboxList.List(cb1, 0)
Row = Row + 1
c.Interior.Color = tbSearchItem.BackColor
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
lbResults.List() = MyArray
lblTotal.Caption = "Total found: " & lbResults.ListCount - 1
End Sub

Function GetCount(What)
shname = cboxList.List(cboxList.ListIndex, 0)
Set sh = ActiveWorkbook.Sheets(shname)

With sh.Range("a:iv")
Set c = .Find(What, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
GetCount = GetCount + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Function

Private Sub UserForm_Activate()
lbResults.ColumnCount = 4

tbSearchItem.Text = ActiveCell.Value
'tbSearchItem.BackColor = 65280
lblTotal.Caption = "Total found: 0"
With cboxList
For Each ws In Worksheets
.AddItem ws.Name
Next ws
idx = MatchIndex
cboxList.ListIndex = idx
End With
lbResults.Width = Me.Width


lbResults.ColumnWidths = "" & ";" & 0 & ";" & 0 & ";" & 0 & ";"

tbSearchItem.SelStart = 0
tbSearchItem.SelLength = Len(tbSearchItem.Value)
End Sub

Private Sub UserForm_Terminate()
Call cbReset_Click
End Sub

Function MatchIndex()
Dim ws
ws = ActiveSheet.Name
For i = 0 To cboxList.ListCount - 1
If ws = cboxList.List(i, 0) Then
MatchIndex = i
End If
Next
End Function