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

  • Thread starter Thread starter ian123
  • Start date Start date
I

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!!
 
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)
 
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
 
Substitute

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

instead of

MsgBox """PY"" found in cell " & found.Address(False, False)
 
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
 
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
 
Back
Top