Hi PKW57,
My cursor stays in "busy" mode unless it is over the results message box. I suspect this is because the results message box is waiting for the click on the OK button. I'm afraid this will confuse the end users. Is there any way to force the cursor back to its default pointer?
It can probably be done with some fancy footwork, but is not recommended. An alternate approach such as a custom UserForm as previously suggested is the way to go.
Second, the results message box give the locations of the found strings in absolute references (with the dollar signs). My manager thinks this is "ugly". How can I get rid of the dollar signs?
I hate the '$' signs too. They are easy to remove.
Sub DisplayOrHideDollarSigns()
'Output Sample text in Immediate Window (CTRL G in Debugger)
Debug.Print Range("A1").Address 'Outputs $A$1
Debug.Print Range("A1").Address(True, True) 'Outputs $A$1
Debug.Print Range("A1").Address(True, False) 'Outputs A$1
Debug.Print Range("A1").Address(False, True) 'Outputs $A1
Debug.Print Range("A1").Address(False, False) 'Outputs A1
'NOTE: First True/False value is for ROW
' Seconds True/False value is for COLUMN
End Sub
my manager would like it if the locations in the results message box could be hyperlinks to the actual cell listed. Is this even possible from a message box?
See the attached file that uses a UserForm with the code that follows. This should get you started with what you want. It is implemented as follows. The User:
a. Opens a UserForm by Clicking a CommandButton. The UserForm can be opened in several different ways, but I find the CommandButton approach to usually be the most convenient.
b. Fills in a TextBox with the item to be searched for (similar to your InputBox).
c. Selects 'Search'
d. A 'ListBox' in the UserForm is populated with the search results.
e. 'Double Clicks' a line in the list box to go to that cell (similar to Hyperlink).
UserForm1 module code:
Option Explicit
Private Sub UserForm_Initialize()
With LabelStatus
.Font.Name = "Arial"
.Font.Size = 10
.Font.Bold = True
.ForeColor = vbBlue 'Font Color
.Caption = "Put text to find in the 'TextBox' and select 'Search'."
End With
With TextBox1
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = True
.ForeColor = vbBlue 'Font Color
End With
With OptionButtonExactMatch
.Font.Name = "Arial"
.Font.Size = 8
.Font.Bold = True
.ForeColor = vbBlack 'Font Color
End With
With OptionButtonPartialMatch
.Font.Name = "Arial"
.Font.Size = 8
.Font.Bold = True
.ForeColor = vbBlack 'Font Color
End With
With ListBox1
.Font.Name = "Arial"
.Font.Size = 10
.Font.Bold = True
.ForeColor = vbBlack
End With
'Initialize the 'TextBox' Tag value
TextBox1.Tag = ""
End Sub
Private Sub TextBox1_Change()
'This processes CHANGES in TextBox1
Dim sValue As String
'Get the TextBox value (with leading/trailing spaces removed)
sValue = Trim(TextBox1.Value)
'Make the 'Search' CommandButton Visible only if the TextBox value has changed.
If sValue = TextBox1.Tag Then
CommandButtonSearch.Visible = False
Else
CommandButtonSearch.Visible = True
End If
End Sub
Private Sub CommandButtonSearch_Click()
'This searches for matches to the value in TextBox1 and puts the results in 'ListBox1'
Call SearchAndDisplayResultsInUserForm1ListBox1
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'This puts the focus on the 'Sheet' and 'Cell' that are on the line that was 'Double Clicked'
Dim iListBoxRow As Long
Dim sCellAddress As String
Dim sSheetName As String
'Get the ListBox Row selected
'Get the 'Sheet Name' and the 'Cell Address'
iListBoxRow = UserForm1.ListBox1.ListIndex
sSheetName = UserForm1.ListBox1.List(iListBoxRow, 1)
sCellAddress = UserForm1.ListBox1.List(iListBoxRow, 3)
'Put the focus on the 'Sheet' and 'Cell Address' selected
ThisWorkbook.sheets(sSheetName).Select
ThisWorkbook.sheets(sSheetName).Range(sCellAddress).Select
'Close the UserForm
Unload Me
End Sub
Ordinary Code module code (such as Module1):
Option Explicit
Sub DisplayModalUserForm1()
'Modal UserForm locks out all Excel Access (vbModal)
'Modeless UserForm allows access to Excel Resources while UserForm is active (vbModeless)
UserForm1.Show vbModal
End Sub
Sub DisplayModelessUserForm1()
'Modal UserForm locks out all Excel Access (vbModal)
'Modeless UserForm allows access to Excel Resources while UserForm is active (vbModeless)
UserForm1.Show vbModeless
End Sub
Public Function SearchAndDisplayResultsInUserForm1ListBox1()
'Search all worksheets and output a message box with all the found data addresses
'
'The ListBox Column Assignments (First Column is Column 0):
'0 = 'Sheet'
'1 = Sheet Name
'2 = 'Cell'
'3 = Cell Address
'
'NOTE: This is a function to remove it from the List of Macros that can be called directly from Excel (ALT F8)
Dim ws As Worksheet
Dim r As Range
Dim iFoundCount As Long
Dim iListBoxRow As Long
Dim bProcessThisSheet As Boolean
Dim bExactMatchRequired As Boolean
Dim sAddress As String
Dim sMatchTypeRequired As String
Dim sSheetName As String
Dim sSearchString As String
Dim sFirstAddress As String
Dim sConcatenation As String
Dim sMessage As String
'Get the 'Search String' from the UserForm (with leading/trailing spaces removed)
sSearchString = Trim(UserForm1.TextBox1.Value)
'Clear the contents of the ListBox
UserForm1.ListBox1.Clear
'Determine if an Exact Match is required or if a Partial Match is OK
bExactMatchRequired = UserForm1.OptionButtonExactMatch.Value
'Initialize the ListBox Row Number
iListBoxRow = -1
'Exit if the Search String is BLANK
If Len(sSearchString) = 0 Then
Exit Function
End If
'Search each Sheet in the Workbook (unless the sheet is to be IGNORED)
For Each ws In ThisWorkbook.Worksheets
'Get the Current Sheet Name
sSheetName = ws.Name
'Determine if this Sheet is to be Processed
Select Case sSheetName
Case "Navigation Instructions"
bProcessThisSheet = False
Case Else
bProcessThisSheet = True
End Select
If bProcessThisSheet = True Then
'Find the first match on the Sheet
If bExactMatchRequired = True Then
sMatchTypeRequired = " (COMPLETE EXACT Match Required)"
Set r = ws.UsedRange.Find(what:=sSearchString, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
Else
sMatchTypeRequired = " (Partial Match Acceptable)"
Set r = ws.UsedRange.Find(what:=sSearchString, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
End If
'Continue processing only if the First Match was found
If Not r Is Nothing Then
sFirstAddress = r.Address(False, False) '(False, False) removes BOTH '$ signs from the address
sAddress = sFirstAddress
Do
'Increment the 'Found' Count
iFoundCount = iFoundCount + 1
'Increment the ListBox row number
iListBoxRow = iListBoxRow + 1
'Add the next row to the ListBox
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(iListBoxRow, 0) = "Sheet"
UserForm1.ListBox1.List(iListBoxRow, 1) = sSheetName
UserForm1.ListBox1.List(iListBoxRow, 2) = "Cell"
UserForm1.ListBox1.List(iListBoxRow, 3) = sAddress
'Look for the 'Next' Match
'Exit if there is NO MATCH (should never occur) or when the First Address repeats
Set r = ws.UsedRange.FindNext(r)
sAddress = r.Address(False, False)
Loop While Not r Is Nothing And sAddress <> sFirstAddress
End If
End If
Next ws
'Display a message in the UserForm Status Label
If iFoundCount = 0 Then
sMessage = "Unable to find " & sSearchString & " in this workbook" & sMatchTypeRequired & "." & vbCrLf & _
"To search AGAIN, Put text to find in the 'TextBox' and select 'Search'."""
Else
sMessage = "Found '" & sSearchString & "' " & iFoundCount & " times" & sMatchTypeRequired & "." & vbCrLf & _
"'Double Click' a line in the 'ListBox' to go to that Cell, or " & vbCrLf & _
"To search AGAIN, Put text to find in the 'TextBox' and Select 'Search'."
End If
UserForm1.LabelStatus.Caption = sMessage
End Function
There are two ways to implement a UserForm:
a. Modal - Locks out Excel except for the UserForm.
b. Modeless - Allows access to Excel Resources.
Lewis
LinkBack URL
About LinkBacks
PKW57 
]
Register To Reply
Bookmarks