• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

Add Search button to Excel Form|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / Add Search button to Excel Form|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosAdd Search button to Excel Form
sp_PrintTopic sp_TopicIcon
Add Search button to Excel Form
Avatar
Tom Wylie

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 8, 2020
sp_UserOfflineSmall Offline
1
January 8, 2020 - 5:33 am
sp_Permalink sp_Print

Using the great information provided in the Excel Forms post (https://www.myonlinetraininghu.....xcel-forms) I have been able to develop an input form which allows users to add information to a "Results" table.  Data from the "Results" table is then used to create a dashboard which displays the various items for the time frame selected.

The problem I'm having is trying to add a Search button to the form.  The purpose of this button is to allow the user to enter a record number, click on the Search button and have the form populated with the corresponding data set located in the "Results" table.

I think it's important to note I have very limited VBA experience and even less knowledge.  Any help would be appreciated!

Thanks

Avatar
Purfleet
England
Member
Members


Trusted Members
Level 4
Forum Posts: 412
Member Since:
December 20, 2019
sp_UserOfflineSmall Offline
2
January 8, 2020 - 6:01 am
sp_Permalink sp_Print

Can you provide an example of what you are looking for and where the data is held with in the workbook?

Avatar
Tom Wylie

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 8, 2020
sp_UserOfflineSmall Offline
3
January 9, 2020 - 12:15 am
sp_Permalink sp_Print sp_EditHistory

User-Form-1.jpgImage Enlarger

Thanks for the reply Purfleet.  While company policy prevents me from sharing the actual file, I have attached a screenshot of the user form along with the "Frankenstein" code I've cobbled together with this reply.

To be a bit more clear, I'd like to provide the user the ability to enter a "Record No." in a search box which would then populate the form with the corresponding data.  The purpose behind this is to allow the user to edit the data.  The data is located in the table "Results" which is in a separate worksheet within the workbook. 

Any assistance is appreciated!

 

Option Explicit
Private ResultsTable As ListObject
Private CurrentRow As Long
Private WithEvents Calendar1 As cCalendar

' Form design and code written by Philip Treacy
' http://www.myonlinetraininghub.....ate-delete
'
'###############################################################
'# Calendar class written by #
'# Krisztina Szabó #
'# Gábor Madács #
'# Roberto Mensa (nick r) #
'# https://sites.google.com/site/.....trol-class #
'###############################################################
'

Function IsAcceptedNumber(Ctrl As MSForms.Control) As Boolean

' Checks if :
'
' Ctrl.Value > 0
' Ctr.Value can be converted to valid double
' Ctr.Value returns TRUE from IsNumeric - bear in mind $4,4 is regarded as TRUE by IsNumeric
' Ctr.Value contains zero , (commas)
' Ctr.Value contains only one . (decimal point)
' Ctr.Value contains zero currency symbols
' Ctrl.Value has maximum three decimal places
'

Dim DoubleValue As Double
Dim CurrSym As String
Dim DecSep As String
Dim ThouSep As String

'Check for system definitions of these
CurrSym = Application.International(xlCurrencyCode)
DecSep = Application.International(xlDecimalSeparator)
ThouSep = Application.International(xlThousandsSeparator)

'Ignore errors
On Error Resume Next

DoubleValue = CDbl(Ctrl.Value)

'Value can't be converted to double or is negative
If Err.Number <> 0 Or Not DoubleValue > 0 Then

'Return error handling to Excel
On Error GoTo 0
IsAcceptedNumber = False
FlagError Ctrl
Exit Function

Else

'Return error handling to Excel
On Error GoTo 0

End If

'If a decimal separator is present
If (InStr(Ctrl.Value, DecSep) > 0) Then

'Make sure the number contains a maximum of 3 decimal places
If ((Len(Mid(Ctrl.Value, InStr(Ctrl.Value, DecSep))) - 1) > 3) Then

IsAcceptedNumber = False
FlagError Ctrl
Exit Function

End If

End If

' If the value is greater than 0 AND
' is considered numeric AND
' contains 0 currency symbols AND
' contains 0 thousands separators AND
' contains no more than one decimal separator

If Ctrl.Value > 0 And IsNumeric(Ctrl.Value) And (InStr(Ctrl.Value, CurrSym) = 0) And (InStr(Ctrl.Value, ThouSep) = 0) And (Len(Ctrl.Value) - Len(Replace(Ctrl.Value, DecSep, "")) <= 1) Then

IsAcceptedNumber = True

Else

FlagError Ctrl
IsAcceptedNumber = False

End If

End Function

Sub FlagError(Ctrl As MSForms.Control)

Ctrl.BorderStyle = fmBorderStyleSingle
Ctrl.BorderColor = &HFF&

End Sub

--------------------------------------------

Sub ClearError(Ctrl As MSForms.Control)

Ctrl.BorderStyle = fmBorderStyleNone
Ctrl.BorderColor = &H80000006
Ctrl.SpecialEffect = fmSpecialEffectSunken

End Sub

--------------------------------------------

Function CheckForErrors() As Integer

Dim ErrorsFound As Integer
Dim CompletedResults As Integer
Const ResultsFields As Integer = 5
Dim aDecimal As Double
Dim Ctrl As MSForms.Control

ErrorsFound = 0
CompletedResults = ResultsFields

For Each Ctrl In ResultsForm.Controls

Select Case TypeName(Ctrl)

Case "TextBox"
'If the text box is empty
If Ctrl.Value = "" Then

'If the text box is not optional i.e. it must contain something
If Ctrl.Tag <> "Optional" Then

FlagError Ctrl
ErrorsFound = ErrorsFound + 1

Else

ClearError Ctrl
'At this point we have an empty Results field.
'Record this for now and we'll check again later
CompletedResults = CompletedResults - 1

End If

End If

Case "ComboBox"
'If the ComboBox is empty
If Ctrl.ListIndex = "" Then

'If the ComboBox is not optional i.e. it must contain something
If Ctrl.ListIndex <> "Optional" Then

FlagError Ctrl
ErrorsFound = ErrorsFound + 1

Else

ClearError Ctrl
'At this point we have an empty Results field.
'Record this for now and we'll check again later
CompletedResults = CompletedResults - 1

End If

Else

If Ctrl.ListIndex = -1 And (Ctrl.Name = "CB_Location" Or Ctrl.Name = "CB_Measure" Or Ctrl.Name = "CB_Category" Or Ctrl.Name = "CB_Manager" Or Ctrl.Name = "CB_Department" Or Ctrl.Name = "CB_RecordNo") Then

FlagError Ctrl
ErrorsFound = ErrorsFound + 1

End If

End If

End Select

Next Ctrl

'Chosen date can not be after today
'If Calendar1.Value > Date Then

' FlagError CalendarFrame
' ErrorsFound = ErrorsFound + 1

'Else

' ClearError CalendarFrame

'End If

'If all Results fields are empty
If CompletedResults = 0 Then

'Check each Results field and flag the ones in error
For Each Ctrl In ResultsForm.Controls

Select Case TypeName(Ctrl)

Case "TextBox"
If Ctrl.Value = "" And Ctrl.Tag = "Optional" Then

FlagError Ctrl

End If

Case "ComboBox"

If Ctrl.ListIndex = "" And Ctrl.Tag = "Optional" Then

FlagError Ctrl

End If

End Select

Next Ctrl

CheckForErrors = 1

Else

CheckForErrors = ErrorsFound

End If

End Function

Private Sub ResetForm()

'
' Need to reset errors here too
'

Dim Ctrl As MSForms.Control

For Each Ctrl In ResultsForm.Controls

Select Case TypeName(Ctrl)

Case "TextBox"
Ctrl.Text = ""
ClearError Ctrl

Case "ComboBox"
If Ctrl.Name = "" Or Ctrl.Name = "CB_Location" Or Ctrl.Name = "CB_Measure" Or Ctrl.Name = "CB_Category" Or Ctrl.Name = "CB_Manager" Or Ctrl.Name = "CB_Department" Or Ctrl.Name = "CB_RecordNo" Then

Ctrl.ListIndex = -1
ClearError Ctrl

End If

End Select

Next Ctrl

Calendar1.Value = Date
ClearError CalendarFrame

End Sub

--------------------------------------------

Private Sub PopulateForm(SelectedRow As Range)

With SelectedRow

CB_SearchRecord.Value = .Cells(1, 1)
Calendar1.Value = .Cells(1, 3)
CB_Measure.Value = .Cells(1, 8)
TB_Result.Value = .Cells(1, 9)
CB_Category.Value = .Cells(1, 13)
CB_Manager.Value = .Cells(1, 14)
CB_Department.Value = .Cells(1, 15)
CB_Location.Value = .Cells(1, 16)
TB_Comment.Value = .Cells(1, 17)
TB_Description.Value = .Cells(1, 18)
CB_Risk.Value = .Cells(1, 19)
TB_Impact.Value = .Cells(1, 20)
TB_Likelihood.Value = .Cells(1, 21)
TB_Level.Value = .Cells(1, 22)
TB_Who.Value = .Cells(1, 23)
TB_What.Value = .Cells(1, 24)
TB_Target.Value = .Cells(1, 25)
TB_When.Value = .Cells(1, 26)
CB_Hyperlink.Value = .Cells(1, 27)

End With

End Sub

--------------------------------------------

Private Sub UpdateRecordDisplay()

Worksheets("Results").Activate

With ResultsTable

RecordPosition.Caption = CurrentRow & " of " & .ListRows.Count
PopulateForm .ListRows(CurrentRow).Range
.ListRows(CurrentRow).Range.Select

End With

Worksheets("Dashboard").Activate

End Sub

--------------------------------------------

Private Sub ChangeRecord_SpinUp()

If ResultsTable.ListRows.Count < 1 Then Exit Sub

If CurrentRow > 1 Then

CurrentRow = CurrentRow - 1

UpdateRecordDisplay

End If

End Sub

--------------------------------------------

Private Sub ChangeRecord_SpinDown()

If CurrentRow = ResultsTable.ListRows.Count Then Exit Sub

If CurrentRow < ResultsTable.ListRows.Count Then

CurrentRow = CurrentRow + 1

UpdateRecordDisplay

End If

End Sub

--------------------------------------------

Private Sub UpdatePositionCaption()

RecordPosition.Caption = CurrentRow & " of " & ResultsTable.ListRows.Count

End Sub

--------------------------------------------

Private Sub ClearForm_Click()

ResetForm

End Sub

--------------------------------------------

Private Sub DeleteResults_Click()

If ResultsTable.ListRows.Count < 1 Then Exit Sub

Dim promptanswer As Integer

promptanswer = MsgBox("Are you sure you want to delete this record?", vbYesNo + vbQuestion, "Confirm deleting record")

If promptanswer = vbYes Then

Sheets("Results").Unprotect Password:="xxxxxx"

Worksheets("Results").Activate

ResultsTable.ListRows(CurrentRow).Delete

If ResultsTable.ListRows.Count > 0 Then

If CurrentRow > ResultsTable.ListRows.Count Then

CurrentRow = ResultsTable.ListRows.Count

End If
Else
CurrentRow = 0

End If

Worksheets("Dashboard").Activate

ChangeRecord.Max = ChangeRecord.Max - 1

UpdateRecordDisplay

UpdatePositionCaption

Sheets("Results").Protect Password:="xxxxxx"

Else
'do nothing
End If
End Sub

--------------------------------------------

Private Sub UpdateResults_Click()

If CheckForErrors > 0 Or ResultsTable.ListRows.Count < 1 Then Exit Sub

ModifyTableRow ResultsTable.ListRows(CurrentRow).Range

End Sub

--------------------------------------------

Private Sub CloseForm_Click()

Unload ResultsForm

End Sub

--------------------------------------------

Private Sub AddResults_Click()

Sheets("Results").Unprotect Password:="xxxxxx"

If CheckForErrors > 0 Then Exit Sub

Sheets("Results").ListObjects("Results").ListRows.Add

ModifyTableRow ResultsTable.ListRows(ResultsTable.ListRows.Count).Range

UpdatePositionCaption

Sheets("Results").Protect Password:="xxxxxx"

End Sub

--------------------------------------------

Private Sub ModifyTableRow(TableRow As Range)

Sheets("Results").Unprotect Password:="xxxxxx"

With TableRow

.Cells(1, 2) = Calendar1.Value
.Cells(1, 8) = CB_Measure.Value
.Cells(1, 9) = TB_Result.Value
.Cells(1, 13) = CB_Category.Value
.Cells(1, 14) = CB_Manager.Value
.Cells(1, 15) = CB_Department.Value
.Cells(1, 16) = CB_Location.Value
.Cells(1, 17) = TB_Comment.Value
.Cells(1, 18) = TB_Description.Value
.Cells(1, 19) = CB_Risk.Value
.Cells(1, 20) = TB_Impact.Value
.Cells(1, 21) = TB_Likelihood.Value
.Cells(1, 22) = TB_Level.Value
.Cells(1, 23) = TB_Who.Value
.Cells(1, 24) = TB_What.Value
.Cells(1, 25) = TB_Target.Value
.Cells(1, 26) = TB_When.Value
.Cells(1, 27) = CB_Hyperlink.Value

End With

ChangeRecord.Max = ResultsTable.ListRows.Count

Sheets("Results").Protect Password:="xxxxxx"

End Sub

--------------------------------------------

Private Sub UserForm_Initialize()
Set ResultsTable = Sheets("Results").ListObjects("Results")

If Calendar1 Is Nothing Then

Set Calendar1 = New cCalendar

With Calendar1

.Add_Calendar_into_Frame Me.CalendarFrame
.UseDefaultBackColors = False
.DayLength = 3
.MonthLength = mlENShort
.Height = 142
.Width = 180
.GridFont.Size = 7
.DayFont.Size = 7
.Refresh

End With

End If

'Initialise for empty table
ChangeRecord.Min = 0
ChangeRecord.Max = 0

CurrentRow = ResultsTable.ListRows.Count

If CurrentRow > 0 Then

ChangeRecord.Min = 1

ChangeRecord.Max = ResultsTable.ListRows.Count

'Load last record into form

'Worksheets("Results").Activate

'PopulateForm ResultsTable.ListRows(ResultsTable.ListRows.Count).Range

'ResultsTable.ListRows(ResultsTable.ListRows.Count).Range.Select

'UpdatePositionCaption

Worksheets("Dashboard").Activate

Else

RecordPosition.Caption = "0 of 0"

End If

End Sub

sp_PlupAttachments Attachments
  • sp_PlupImage User-Form-1.jpg (142 KB)
Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1510
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
4
January 9, 2020 - 11:42 am
sp_Permalink sp_Print

Hi Tom,

In the attached workbook I've created a form that will search a table to match a record number, then populate the form fields with the data from that matching row.  You should be able to adapt this code to your own situation.

The code uses structured references to access the table so you'll need to modify this according to your data.

If you have any questions about it please ask.

Regards

Phil

Avatar
Tom Wylie

Active Member
Members
Level 0
Forum Posts: 3
Member Since:
January 8, 2020
sp_UserOfflineSmall Offline
5
January 10, 2020 - 5:06 am
sp_Permalink sp_Print

Phillip,

Thank you!  I was able to take your code and combine it with the existing "UpdateRecordDisplay" and "UpdagePositionCaption" subs to make it work nicely.

Private Sub SearchResults_Click()

Dim RecordRow As Long
Dim RecordRange As Range
'Debug.Print TextBox1.Value
'Range("Table1[Record]").Select

On Error Resume Next
RecordRow = Application.Match(CLng(TB_RecordNo.Value), Range("Results[Record]"), 0)
'Range("Table1").Cells(1, 1).Offset(RecordRow - 1, 0).Select
Set RecordRange = Range("Results").Cells(1, 1).Offset(RecordRow - 1, 0)

'Debug.Print Err.Number

If Err.Number <> 0 Then

TB_RecordNo.Value = "Record not found."
On Error GoTo 0
Exit Sub

End If

On Error GoTo 0

UpdateRecordDisplay

UpdatePositionCaption

Me.TB_RecordNo.Value = ""

End Sub

 

The dashboard I've created has been well received within my organization and in all sincerity, I absolutely could not have done it without the great information and support received from myonlinetraininghub.  What a tremendous resource it's been for someone like me!

 

My Best,

Tom

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1510
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
6
January 10, 2020 - 9:26 am
sp_Permalink sp_Print

No worries Tom.  Glad that we can help and great to hear that it's had a positive impact at your work.

All the best for 2020.

Regards

Phil

Avatar
William Self

New Member
Members
Level 0
Forum Posts: 1
Member Since:
December 9, 2021
sp_UserOfflineSmall Offline
7
February 8, 2022 - 3:29 am
sp_Permalink sp_Print

Tom, I am not sure if you will receive this message being that it has been years ago since you created the thread but I thought I would try. First of all I apologize for asking it in the thread but I cannot find a method for reaching out to you directly. I would like to know if you would be willing to share the template you created for your team. I am interested in learning from it and trying to create something like you have created. Thank you for your time and support. If you need to email me directly please use Templates_Documents@yahoo.com.

Thanks

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Velouria, Dieneba NDIAYE, Ben Hughes, Dario Serrati, Christopher Anderson, Natasha Smith, dectator mang, Oluwadamilola Ogun, yashal minahil
Guest(s) 9
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 870
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
A.Maurizio: 202
Jessica Stewart: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
yashal minahil
Oluwadamilola Ogun
Yannik H
dectator mang
Francis Drouillard
Orlando Inocente
Jovitha Clemence
Maloxat Axmatovna
Ricardo Freitas
Marko Meglic
Forum Stats:
Groups: 3
Forums: 24
Topics: 6200
Posts: 27181

 

Member Stats:
Guest Posters: 49
Members: 31858
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.