VBA for multi-criteria find using a UserForm?

I

iAmPatch

Board Regular
Joined
Jan 13, 2015
Messages
86
Hi

I've created an inventory tracker with the help of @My Awser Is This
The inventory tracker has 3 worksheets, Dashboard, Released Items and Purchase Orders
In the Dashboard worksheet, I already have 2 command buttons (Add Released Items and Add Purchase Order) which pops up UserForms respectively

I would like to ask for assistance in coding a third command button which when clicked on, would pop up another UserForm wherein the user would key in specific search criteria (Vendor and Item). Once done, the user would then click on the "Search" button and the code should search in Purchase Orders sheet. If the value of the searched item in Purchase Orders is "0" or there is no item match; user should be routed to the Purchase Order UserForm. But if there is an available item, the user should be routed to the Released Items UserForm.

I tried using the record-macro option and fooling around with the "Find" function of Excel; but Excel didn't record the "Find" steps I did ...

Is this possible to do?

Thanks
 
Last edited:
Sort by date Sort by votes
I got lost with the last part of your reply :(

But I guess to answer the question of why there's a need for 4 UserForms is that each UserForm has different fields to fill in; and each UserForm has it's own unique function for the inventory tracker
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Have you ever looked at Userform Multipages

In your UserForm toolbox you should see Multipage

You can then have like 4 or 5 or more Userforms all on the same userform.

Just like you can have 10 sheets on one workbook

Each Multipage has a tab just like sheet tabs.

You can put as many buttons as you want on each Multipage

Jut click the multipage tab like you do a sheet tab to go to next Multipage

You may want to look into that. Its a lot easier then having 4 Userforms.
 
Upvote 0
I've never encountered this before. But seeing how it looks seems more "user-friendly". I just need to figure out how to incorporate the codes I've already established in the first 2 UserForms
 
Upvote 0
Try this:

Code: 
Sub My_Sub()
'Modified 4-10-18 3:15 AM EDT
Dim SearchString As String
Dim SearchRange As Range
SearchString = TB_SearchValue.Value
Set SearchRange = Sheets("Purchase Orders").Range("A:A").Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then PurchaseOrder.Show: Exit Sub
ans = SearchRange.Offset(, 5).Value
MyMessage = "Hey, there's still  "
MyMessagetwo = "of this that you can giveaway"

MsgBox MyMessage & ans & SearchString & MyMessagetwo
ReleasedItems.Show
End Sub
 
Last edited:
Upvote 0
My last post was assuming you were sticking with your previous plan of having 4 userforms.

If you need help with multipage let me know.

On multipage when needing the same button to do the same task no matter what multipage your working with like the close userform button.
Just put that button on the userform but outside the multipage.

This way you can always see some buttons no matter what multipage you are seeing at the moment.

I have a userform I use that has about 5 multipages.

Each multipage has a caption identifying what that multipage is for.

Then each multipage has about 20 textboxes and option buttons I can use.
Have fun and check back if you need more help
 
Upvote 0
the last code provided works like a charm... then when I went ahead to edit it; I definitely broke it.... here's the updated one

Code: 
Private Sub Command_Search_Click()

Dim SearchString As String
Dim SearchRange As Range

SearchString = TB_SearchValue.Value

Set SearchRange = Sheets("Purchase Orders").Range("A:A").Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)

If SearchRange Is Nothing Then
MyMessagethree = "I'm sorry, this item isn't available."
MsgBox MyMessagethree
PurchaseOrder.Show:
Exit Sub

ans = SearchRange.Offset(, 5).Value
MyMessage = "Hey, there's still "
MyMessagetwo = " that you can giveaway!"

MsgBox MyMessage & ans & MyMessagetwo
ReleasedItems.Show

End Sub

how come the SearchRange.Offset(, 5).Value is "5" and not "6"? Is this because we started the count from Column B, because of the SearchRange set earlier on?

then I tried to follow the context of the "MyMessage"; creating "MyMessagethree", which I think broke your code. Should the MyMessage be arranged in a particular order?
 
Upvote 0
by the way, I already started watching videos regarding MultiPages. And you're right, it's indeed better than having a lot of UserForms. My struggle here though is with the coding. In my current set-up; each UserForm has the same naming convention for the buttons for "Adding in an item" and closing the form.

If I am to migrate them to the MultiPage, will the codes not overlap?
 
Upvote 0
If your using a Mutipage. You would not be closing a particular multipage you would just select the multipage you want. And then the other multipage would not be visible sort of like when you select one worksheet the other worksheet is still open you just cannot see it.

Here is how the new script would look if using Multipage

You would need to name your multipage as you used in your previous code where you used Userform names

To name your mutipages just click on the tab and enter the name in the Vba Project window. I would name and set the caption name the same.

You will see name and caption

Then use this script to do this part.

Not sure why you needed 4 userforms I see two in this script but I forget what the others were for.

Code: 
Private Sub CommandButton4_Click()
'Modified 4-10-18 6:40 AM EDT
Dim SearchString As String
Dim SearchRange As Range
SearchString = TB_SearchValue.Value
Set SearchRange = Sheets("Purchase Orders").Range("A:A").Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then
MyMessagethree = "I'm sorry, this item isn't available."
MsgBox MyMessagethree
MultiPage1.Value = MultiPage1.Pages("PurchaseOrder").Index
Exit Sub
End If
ans = SearchRange.Offset(, 5).Value
MyMessage = "Hey, there's still "
MyMessagetwo = " that you can giveaway!"
MsgBox MyMessage & ans & MyMessagetwo
MultiPage1.Value = MultiPage1.Pages("ReleasedItems").Index
End Sub
 
Upvote 0
I got lost with the MultiPage code :|
When I copied the code and updated the (Name) for the Search button; I got this error: "Compile Error: Member already exists in an object module from which this object module derives"

Here's the full updated code that I have:
Code: 
Private Sub Command_Search2()

'code below is for Search function (Tab 1)

Dim SearchString As String
Dim SearchRange As Range
SearchString = TB_SearchValue.Value

Set SearchRange = Sheets("Purchase Orders").Range("A:A").Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)

If SearchRange Is Nothing Then
MyMessagethree = "I'm sorry, this item isn't available."
MsgBox MyMessagethree
MultiPage1.Value = MultiPage1.Pages("Purchase Order").Index
Exit Sub

End If
ans = SearchRange.Offset(, 5).Value
MyMessage = "Hey, there's still "
MyMessagetwo = " that you can giveaway!"
MsgBox MyMessage & ans & MyMessagetwo
MultiPage1.Value = MultiPage1.Pages("Released Items").Index

End Sub

Private Sub Command_AddPurchase_Click()

'code below is for Adding Purchase Order

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Purchase Orders")

'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
  .Cells(lRow, 2).Value = Format(Me.TB_DateOrdered, "MMMM DD, YYYY")
  .Cells(lRow, 3).Value = Format(Me.TB_PONumber, "0000")
  .Cells(lRow, 4).Value = Me.TB_Item
  .Cells(lRow, 5).Value = Me.TB_Vendor
  .Cells(lRow, 6).Value = Format(Me.TB_OnHand, "0000")
  .Cells(lRow, 7).Value = Format(Me.TB_NumberOfItemsOrdered, "0000")

End With

End Sub

Private Sub Command_ReleaseForm_Click()

'code below is for Adding Released Items

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Released Items")

'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
  .Cells(lRow, 1).Value = Format(Me.TB_Date, "MMMM DD, YYYY")
  .Cells(lRow, 2).Value = Me.TB_Item
  .Cells(lRow, 3).Value = Me.CB_Category
  .Cells(lRow, 4).Value = Me.TB_Recipient
  .Cells(lRow, 5).Value = Format(Me.TB_NoOfPcs, "0000")
  .Cells(lRow, 6).Value = Me.CB_Purpose
  .Cells(lRow, 7).Value = Me.TB_Promo
End With

End Sub

Private Sub UserForm_Initialize()

'code below is for the Drop Down list for Released Items

Dim myrng As Range
Dim cl As Range
Set ws = Worksheets("Lookup")

    Set myrng = ws.Range("Category")

    With Me.CB_Category
        .Clear
        For Each cl In myrng.Cells
            If cl.Value <> "" Then
                .AddItem cl.Value
            End If
        Next cl
    End With
    
Dim myrange As Range
Dim cla As Range
Set ws = Worksheets("Lookup")

    Set myrange = ws.Range("Purpose")

    With Me.CB_Purpose
        .Clear
        For Each cla In myrange.Cells
            If cla.Value <> "" Then
                .AddItem cla.Value
            End If
        Next cla
    End With
    
End Sub

Oh and I was wondering why this particular line doesn't paste the text I enter:
Code: 
.Cells(lRow, 2).Value = Me.TB_Item
The text that is keyed in here is VendorItem (e.g. MGMPencil). When I click on the add button; column B is left blank
 
Upvote 0
all good now, I was able to figure out the errors throughout the codes...

for the Compile Error, it was because I was missing the command "_Click" in the code.
Then for the other code that was misleading; the Name of the TextBoxes used got mixed up and changed

here's the most updated code line I have

Code: 
Private Sub Command_Search_Click()

'code below is for Search function (Tab 1)

Dim SearchString As String
Dim SearchRange As Range
SearchString = TB_SearchValue.Value

Set SearchRange = Sheets("Purchase Orders").Range("A:A").Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)

If SearchRange Is Nothing Then
MyMessagethree = "I'm sorry, this item isn't available."
MsgBox MyMessagethree
MultiPage1.Value = MultiPage1.Pages("PurchaseOrder").Index
Exit Sub

End If
ans = SearchRange.Offset(, 5).Value
MyMessage = "Hey, there's still "
MyMessagetwo = " that you can giveaway!"
MsgBox MyMessage & ans & MyMessagetwo
MultiPage1.Value = MultiPage1.Pages("ReleaseForm").Index

End Sub

Private Sub Command_AddPurchase_Click()

'code below is for Adding Purchase Order

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Purchase Orders")

'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
  .Cells(lRow, 2).Value = Format(Me.TB_DateOrdered, "MMMM DD, YYYY")
  .Cells(lRow, 3).Value = Format(Me.TB_PONumber, "0000")
  .Cells(lRow, 4).Value = Me.TB_POItem
  .Cells(lRow, 5).Value = Me.TB_Vendor
  .Cells(lRow, 6).Value = Format(Me.TB_OnHand, "0000")
  .Cells(lRow, 7).Value = Format(Me.TB_NumberOfItemsOrdered, "0000")

End With

End Sub

Private Sub Command_ReleaseForm_Click()

'code below is for Adding Released Items

Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Released Items")

'find first empty row in database
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'copy the data to the database
With ws
  .Cells(lRow, 1).Value = Format(Me.TB_Date, "MMMM DD, YYYY")
  .Cells(lRow, 2).Value = Me.TB_Item
  .Cells(lRow, 3).Value = Me.CB_Category
  .Cells(lRow, 4).Value = Me.TB_Recipient
  .Cells(lRow, 5).Value = Format(Me.TB_NoOfPcs, "0000")
  .Cells(lRow, 6).Value = Me.CB_Purpose
  .Cells(lRow, 7).Value = Me.TB_Promo
End With

End Sub

Private Sub UserForm_Initialize()

'code below is for the Drop Down list for Released Items

Dim myrng As Range
Dim cl As Range
Set ws = Worksheets("Lookup")

    Set myrng = ws.Range("Category")

    With Me.CB_Category
        .Clear
        For Each cl In myrng.Cells
            If cl.Value <> "" Then
                .AddItem cl.Value
            End If
        Next cl
    End With
    
Dim myrange As Range
Dim cla As Range
Set ws = Worksheets("Lookup")

    Set myrange = ws.Range("Purpose")

    With Me.CB_Purpose
        .Clear
        For Each cla In myrange.Cells
            If cla.Value <> "" Then
                .AddItem cla.Value
            End If
        Next cla
    End With
    
End Sub

Private Sub Command_Close_Click()
    
    Unload Me

End Sub

Private Sub Command_PClose_Click()
    
    Unload Me

End Sub

Private Sub Command_RClose_Click()
    
    Unload Me

End Sub

All codes are working smoothly now and I still have a lot to learn about the MultiPage function. But it is indeed interesting and quite helpful :)

Thank you so much for all your help
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
vba/macro to Find a line on another sheet and replace information in just 1 cell in that line
Replies
5
Views
96
mumps
mumps
D
  • Question Question
VBA Basic Userform - add -update -delete
Replies
3
Views
685
Drexi
D
M
  • Question Question
Code works however receiving Runtime error 380 - Could not set the list property. Invalid property value
Replies
2
Views
885
Megg
M
B
  • Question Question
Stopping the save button from clearing textboxes on UserForm.
Replies
2
Views
529
bandito04
B
R
  • Question Question
Saving and retrieving userforms
Replies
6
Views
491
rlv01
R

Forum statistics

Threads
1,224,828
Messages
6,181,210
Members
453,023
Latest member
alabaz

Share this page

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
Back
Top