Macro VBA for a search function

janehancock

New Member
Joined
Jan 31, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I am trying to set up a search box and I am using the code below for a macro from this site (How To Create A Filtering Search Box For Your Excel Data — TheSpreadsheetGuru) . It works fine but I need the search results to include the cell from two rows above and four rows above each search result to show as well as they have details (name and date) belonging to the search result (see attached picture) I am a complete VBA novice so all help greatly appreciated. If you are kind enough to reply please can it be idiot proof! thank you.

Sub SearchBox()
'PURPOSE: Filter Data on User-Determined Column & Text
'SOURCE: www.TheSpreadsheetGuru.com

Dim myButton As OptionButton
Dim MyVal As Long
Dim ButtonName As String
Dim sht As Worksheet
Dim myField As Long
Dim DataRange As Range
Dim mySearch As Variant

'Load Sheet into A Variable
Set sht = ActiveSheet

'Unfilter Data (if necessary)
On Error Resume Next
sht.ShowAllData
On Error GoTo 0

'Filtered Data Range (include column heading cells)
Set DataRange = sht.Range("E7:E300") 'Cell Range
'Set DataRange = sht.ListObjects("Table1").Range 'Table

'Retrieve User's Search Input
mySearch = sht.Range("F2").Value 'Cell Input

'Loop Through Option Buttons
For Each myButton In ActiveSheet.OptionButtons
If myButton.Value = 1 Then
ButtonName = myButton.Text
Exit For
End If
Next myButton

'Determine Filter Field
On Error GoTo HeadingNotFound
myField = Application.WorksheetFunction.Match(ButtonName, DataRange.Rows(1), 0)
On Error GoTo 0

'Filter Data
DataRange.AutoFilter _
Field:=myField, _
Criteria1:="=*" & mySearch & "*", _
Operator:=xlAnd

'Clear Search Field
sht.Shapes("Search").TextFrame.Characters.Text = "" 'Control Form

Exit Sub

'ERROR HANDLERS
HeadingNotFound:
MsgBox "The column heading [" & ButtonName & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"

End Sub
 

Attachments

  • Picture1.png
    Picture1.png
    111 KB · Views: 30

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Watch MrExcel Video

Forum statistics

Threads
1,127,404
Messages
5,624,543
Members
416,034
Latest member
Shiv kumar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top