I'm picking multiple options from a Userform and need the macro to look in another sheet and return results based on those options.

R

RockandGrohl

Well-known Member
Joined
Aug 1, 2018
Messages
810
Office Version
  1. 365
Platform
  1. Windows
Good morning everyone.

I have a userform that shows multiple options, for example 12 checkboxes for the month, 4 checkboxes for categories and some radio buttons here and there.

I need to be able to choose one or more months, one or more options and then press go and have it look into another sheet (PP) and start looping down, copying the contents of certain cells over to the main sheet (TW) for anything applicable to the options.

As an example, if I picked FEB and MAR for "GB" and "EU" it would loop down and pick all products that match a FEB or MAR date which fall into either a "GB" or "EU" category.

Here's what I have below:

  • I set declarations
  • If something is checked, it is written into a new sheet called PPTemp
  • PPTemp has 2 columns, one showing all chosen months and another showing all chosen products (A & C)

At this point, I'm stuck. The critical part is I don't know how to say in VBA terms, if the contents of Column N in PP match the Months declared, AND if the category matches, then start returning results.

Like how do I say "If cell = list"?

Thanks.


Code: 
Set TW = Worksheets("Tour Weighting 1")


Dim Lastrow As Long, LastrowCat As Long, PPTemp As Worksheet


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PPTemp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "PPTemp"
Set PPTemp = Worksheets("PPTemp")
PPTemp.Move before:=TW


PPTemp.Activate
Range("A1").Value = "Month"
Range("B1").Value = "Cat"
Range("C1").Value = "Category"




TW.Activate




If CBJAN = True Then
Jan = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jan"
TW.Activate
Else
Jan = "No"
End If


If CBFEB = True Then
Feb = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Feb"
TW.Activate
Else
Feb = "No"
End If


If CBMAR = True Then
Mar = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Mar"
TW.Activate
Else
Mar = "No"
End If


If CBAPR = True Then
Apr = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Apr"
TW.Activate
Else
Apr = "No"
End If


If CBMAY = True Then
May = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "May"
TW.Activate
Else
May = "No"
End If


If CBJUN = True Then
Jun = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jun"
TW.Activate
Else
Jun = "No"
End If


If CBJUL = True Then
Jul = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jul"
TW.Activate
Else
Jul = "No"
End If


If CBAUG = True Then
Aug = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Aug"
TW.Activate
Else
Aug = "No"
End If


If CBSEP = True Then
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Sep"
TW.Activate
Sep = "OK"
Else
Sep = "No"
End If


If CBOCT = True Then
October = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Oct"
TW.Activate
Else
October = "No"
End If


If CBNOV = True Then
Nov = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Nov"
TW.Activate
Else
Nov = "No"
End If


If CBDEC = True Then
Dec = "OK"
PPTemp.Activate
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Dec"
TW.Activate
Else
Dec = "No"
End If


If CBJGGB1 = True Then
JGGB = "OK"
PPTemp.Activate
Range("C2").Activate
LastrowCat = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & LastrowCat).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "JG GB"
TW.Activate
Else
JGGB = "No"
End If


If CBJGEU1 = True Then
JGEU = "OK"
PPTemp.Activate
LastrowCat = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & LastrowCat).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "JG EU"
TW.Activate
Else
JGEU = "No"
End If


If CBJGE1 = True Then
JGE = "OK"
PPTemp.Activate
LastrowCat = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & LastrowCat).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "JG Events"
TW.Activate
Else
JGE = "No"
End If


If CBJGSV1 = True Then
JGSV = "OK"
PPTemp.Activate
LastrowCat = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & LastrowCat).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Supervalue"
TW.Activate
Else
JGSV = "No"
End If


PPTemp.Activate




Set PP = Workbooks.Open("H:\Sales\Price Panels\Price Panels 2019.xlsm", ReadOnly:=True)




PP.Activate


Range("A3").Activate


Do Until Cells(ActiveCell.Row, "A").Value = ""
    If Cells(ActiveCell.Row, "B").Value <> "Active" Then
    ActiveCell.Offset(1, 0).Activate
    Else
    
    
    
    End If


    ActiveCell.Offset(1, 0).Activate
    Loop


End Sub
 
Sort by date Sort by votes
Thanks dude, here is what I have now:

Code: 
    Dim MonRNG As Variant, CatRNG As Variant, a As Long    Dim rngData As Range                            'PP As Worksheet, PPTemp As Worksheet,
    Dim PPLastrow As Long
    PPLastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = PP.Range("A2:AF" & PPLastrow)
    'array of values for Months and Categories
    MonRNG = PPTemp.Range("A2", PPTemp.Range("A" & Rows.Count).End(xlUp)).Value
    CatRNG = PPTemp.Range("B2", PPTemp.Range("B" & Rows.Count).End(xlUp)).Value
    'convert number categories to text (otherwise filter does not recognise)
    For a = 1 To UBound(CatRNG)
        CatRNG(a, 1) = CStr(CatRNG(a, 1))
    Next a
    'filter
    rngData.AutoFilter Field:=1, Criteria1:=Application.Transpose(MonRNG), Operator:=xlFilterValues    '  months
    rngData.AutoFilter Field:=3, Criteria1:=Application.Transpose(CatRNG), Operator:=xlFilterValues    '  categories
    rngData.AutoFilter Field:=4, Criteria1:=">18", Operator:=xlFilterValues                         '  >18
    rngData.AutoFilter Field:=2, Criteria1:="active", Operator:=xlFilterValues                      '  active

(I have declared PP and PPTemp as Worksheets earlier on in my code)

When I get to "Set rngData = PP.Range etc etc I get object doesn't support this property or method.

When I change it from "A2:AF" & PPLastrow to A:AF I still get the same error.

Cheers.
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Is because you forgot the sheet variable on this line?
Code: 
PPLastrow = [COLOR=#ff0000]PP.[/COLOR]Cells(Rows.Count, "A").End(xlUp).Row
 
Last edited:
Upvote 0
Also
- you said you declared pp and ppTemp but (as you have not included all the code) I cannot see if you Set those variables to their respective worksheets
 
Last edited:
Upvote 0
Yongle said:
Also
- you said you declared pp and ppTemp but (as you have not included all the code) I cannot see if you Set those variables to their respective worksheets
Click to expand...

Hiya,

Here is my complete code with the relevant variables highlighted

Code: 
Application.ScreenUpdating = False

[B]Set TW = Worksheets("Tour Weighting 1")[/B]


Dim Lastrow As Long, LastrowCat As Long, [B]PPTemp As Worksheet[/B]


Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PPTemp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "PPTemp"
[B]Set PPTemp = Worksheets("PPTemp")[/B]
PPTemp.Move before:=TW


Params.Hide


PPTemp.Activate
Range("A1").Value = "Month"
Range("B1").Value = "Category"


If CBJAN = True Then
Jan = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jan"
Else
Jan = "No"
End If


If CBFEB = True Then
Feb = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Feb"
Else
Feb = "No"
End If


If CBMAR = True Then
Mar = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Mar"
Else
Mar = "No"
End If


If CBAPR = True Then
Apr = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Apr"
Else
Apr = "No"
End If


If CBMAY = True Then
May = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "May"
Else
May = "No"
End If


If CBJUN = True Then
Jun = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jun"
Else
Jun = "No"
End If


If CBJUL = True Then
Jul = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Jul"
Else
Jul = "No"
End If


If CBAUG = True Then
Aug = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Aug"
Else
Aug = "No"
End If


If CBSEP = True Then
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Sep"
Sep = "OK"
Else
Sep = "No"
End If


If CBOCT = True Then
October = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Oct"
Else
October = "No"
End If


If CBNOV = True Then
Nov = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Nov"
Else
Nov = "No"
End If


If CBDEC = True Then
Dec = "OK"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & Lastrow).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "Dec"
Else
Dec = "No"
End If


If CBJGGB1 = True Then
JGGB = "OK"
Range("B2").Activate
LastrowCat = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastrowCat + 1).Activate
ActiveCell.Value = "1"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "2"
Else
JGGB = "No"
End If


If CBJGEU1 = True Then
JGEU = "OK"
LastrowCat = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastrowCat + 1).Activate
ActiveCell.Value = "3"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "6"
Else
JGEU = "No"
End If


If CBJGE1 = True Then
JGE = "OK"
LastrowCat = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastrowCat + 1).Activate
ActiveCell.Value = "E"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "F"
Else
JGE = "No"
End If


If CBJGSV1 = True Then
JGSV = "OK"
LastrowCat = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & LastrowCat + 1).Activate
ActiveCell.Value = "7"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "8"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Value = "9"
Else
JGSV = "No"
End If


Set PP = Workbooks.Open("H:\Sales\Price Panels\Price Panels 2019.xlsm", ReadOnly:=True)




PP.Activate
Range("A3").Activate




    Dim MonRNG As Variant, CatRNG As Variant, a As Long
    Dim rngData As Range                            'PP As Worksheet, PPTemp As Worksheet,
    Dim PPLastrow As Long
    PPLastrow = PP.Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = PP.Range("A2:AF" & PPLastrow)
    'array of values for Months and Categories
    MonRNG = PPTemp.Range("A2", PPTemp.Range("A" & Rows.Count).End(xlUp)).Value
    CatRNG = PPTemp.Range("B2", PPTemp.Range("B" & Rows.Count).End(xlUp)).Value
    'convert number categories to text (otherwise filter does not recognise)
    For a = 1 To UBound(CatRNG)
        CatRNG(a, 1) = CStr(CatRNG(a, 1))
    Next a
    'filter
    rngData.AutoFilter Field:=1, Criteria1:=Application.Transpose(MonRNG), Operator:=xlFilterValues    '  months
    rngData.AutoFilter Field:=3, Criteria1:=Application.Transpose(CatRNG), Operator:=xlFilterValues    '  categories
    rngData.AutoFilter Field:=4, Criteria1:=">18", Operator:=xlFilterValues                         '  >18
    rngData.AutoFilter Field:=2, Criteria1:="active", Operator:=xlFilterValues                      '  active
 
Upvote 0
Code: 
Set PP = Workbooks.Open("H:\Sales\Price Panels\Price Panels 2019.xlsm", ReadOnly:=True)
PP is a workbook not a worksheet

Is it the first (or only) sheet?
Code: 
    PPLastrow = PP.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = PP.Sheets(1).Range("A2:AF" & PPLastrow)

or use (amend sheet name)
Code: 
    PPLastrow = PP.Sheets("[COLOR=#006400][I]SheetName[/I][/COLOR]").Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = PP.Sheets("[COLOR=#006400][I]SheetName[/I][/COLOR]").Range("A2:AF" & PPLastrow)

or declare and set another worksheet variable and use that
 
Last edited:
Upvote 0
Got it in the end, with this:

Code: 
Set PP = Workbooks.Open("H:\Sales\Price Panels\Price Panels 2019.xlsm", ReadOnly:=True)

PP.Activate
Range("A3").Activate




    Dim MonRNG As Variant, CatRNG As Variant, a As Long
    Dim rngData As Range                            'PP As Worksheet, PPTemp As Worksheet,
    Dim PPLastrow As Long
    PPLastrow = Cells(Rows.Count, "A").End(xlUp).Row
    PP.Activate
    Set rngData = Range("A2:AF" & PPLastrow)      'array of values for Months and Categories
    MonRNG = PPTemp.Range("A2", PPTemp.Range("A" & Rows.Count).End(xlUp)).Value
    CatRNG = PPTemp.Range("B2", PPTemp.Range("B" & Rows.Count).End(xlUp)).Value
    'convert number categories to text (otherwise filter does not recognise)
    For a = 1 To UBound(CatRNG)
        CatRNG(a, 1) = CStr(CatRNG(a, 1))
    Next a
    'filter
    rngData.AutoFilter Field:=14, Criteria1:=Application.Transpose(MonRNG), Operator:=xlFilterValues    '  months
    rngData.AutoFilter Field:=25, Criteria1:=Application.Transpose(CatRNG), Operator:=xlFilterValues    '  categories
    rngData.AutoFilter Field:=31, Criteria1:=">18", Operator:=xlFilterValues                         '  >18
    rngData.AutoFilter Field:=2, Criteria1:="active", Operator:=xlFilterValues                      '  active


Turns out I needed to put in PP.activate, then remove the reference to PP where I set the range for rngData.


Thanks for all the help my dude it's much appreciated, I've learned something which will be valuable to me now and in the future.
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Question Question
Text Value from Textbox to Integer
Replies
1
Views
362
Kaper
Kaper
I
  • Solved
Open userform in another worksheet
Replies
5
Views
373
ipbr21054
I
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
292
Alex Blakenburg
A
E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
444
Joe4
Joe4
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
212
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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