AutoFilter Results into a user Selection

nmbc99

New Member
Joined
Apr 28, 2022
Messages
20
Office Version
  1. 365
Platform
  1. Windows
Hello! I am trying to create a code that after an autofilter, if there are multiple results then some type of inquiry pops up to allow the user to choose the best option. For example after an autoFilter the following results are showing:
Ms Excel TAKE OFF from
SpecMOCITEMSmallerBiggerRATINGENDSMATERIAL
FB74FRPPipe
(Notes 1, 2, 3)
3.00​
4.00​
150 psiPlain EndNOV Fiber Glass Systems, CL‐2030
Centricast Fiberglass Pipe, Vinyl Ester
Resin with an internal 100‐mil Resin
Liner, ASTM D‐2997, RTRP‐22BS‐4556
FB74FRPPipe
(Notes 1, 2, 3)
4.00​
14.00​
100 psiPlain End
(Butt Wrap)
NOV Fiber Glass Systems, F‐Chem FRP
Pipe, Filament Wound, 100‐mil Vinyl
Ester Resin Liner.
FB74FRPPipe Support
Cradle
1.00​
14.00​
N/AN/ANOV Fiber Glass Systems, Centricast
Pipe Support Cradle/Wear Pad, Fig. 391.

I would create some function to concatenate all the columns in a row to be put into a single cell, so that the user will see all of the information. Like so:

Ms Excel TAKE OFF from
Spec: FB74 MOC: FRP ITEM: Pipe
(Notes 1, 2, 3) Smaller: 3 Bigger: 4 RATING: 150 psi ENDS: Plain End MATERIAL: NOV Fiber Glass Systems, CL‐2030
Centricast Fiberglass Pipe, Vinyl Ester
Resin with an internal 100‐mil Resin
Liner, ASTM D‐2997, RTRP‐22BS‐4556
Spec: FB74 MOC: FRP ITEM: Pipe
(Notes 1, 2, 3) Smaller: 4 Bigger: 14 RATING: 100 psi ENDS: Plain End
(Butt Wrap) MATERIAL: NOV Fiber Glass Systems, F‐Chem FRP
Pipe, Filament Wound, 100‐mil Vinyl
Ester Resin Liner.
Spec: FB74 MOC: FRP ITEM: Pipe Support
Cradle Smaller: 1 Bigger: 14 RATING: N/A ENDS: N/A MATERIAL: NOV Fiber Glass Systems, Centricast
Pipe Support Cradle/Wear Pad, Fig. 391.

Then they will choose which option is the best fit, and it would copy just the "material" column of the row they selected to be the best. So lets say they chose the second one then only the bolded part would be copied:

Ms Excel TAKE OFF from
SpecMOCITEMSmallerBiggerSIZE (NPS)RATINGENDSMATERIAL
FB74FRPPipe
(Notes 1, 2, 3)
3.00​
4.00​
3” to 4”
(80mm to 100mm)
150 psiPlain EndNOV Fiber Glass Systems, CL‐2030
Centricast Fiberglass Pipe, Vinyl Ester
Resin with an internal 100‐mil Resin
Liner, ASTM D‐2997, RTRP‐22BS‐4556
FB74FRPPipe
(Notes 1, 2, 3)
4.00​
14.00​
4” to 14”
(100mm to 350mm)
*Forbranchconnections
onF‐Chemheaders
100 psiPlain End
(Butt Wrap)
NOV Fiber Glass Systems, F‐Chem FRP
Pipe, Filament Wound, 100‐mil Vinyl
Ester Resin Liner.
FB74FRPPipe Support
Cradle
1.00​
14.00​
1” to 14”
(25mm to 350mm)
N/AN/ANOV Fiber Glass Systems, Centricast
Pipe Support Cradle/Wear Pad, Fig. 391.
Hopefully this makes sense.

Is something like that possible? If not does anyone have any suggestions on something I could do instead?

As of now I have my autofilter working if there is a single result, I'm just not sure how to do multiple is a "hands off" way.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
The material information you want copied is copied where? To the clipboard? To a cell?
 
Upvote 0
The material information you want copied is copied where? To the clipboard? To a cell?
It would be pasted to another cell in a different sheet. I have my code successfully doing that if there is only 1 result from the autofilter:

VBA Code:
If x = 1 Then
    lastCol = ItemRange.Cells(1, Columns.Count).End(xlToLeft).Column
    Set srcRow = ItemRange.Range("A1", ItemRange.Cells(1, lastCol))
    Set found = srcRow.Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)
    MsgBox (found.Column & vbNewLine _
    & found.Address)
    
    lastRow = .Columns(found.Column).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
    Set test = Selection
    test.Copy Destination:=Worksheets("Take Off...your INITIALS").Range("T9")
  
    ActiveCell.Copy Destination:=Worksheets("Take Off...your INITIALS").Range("T9")
        End If

However, now I'm trying to handle if there are multiple results from the autofilter. If there are multiple results I want some type of query to come up and ask them to chose which one is the best and then paste their choice into cell "T9" in the other sheet.
 
Upvote 0
You could do something like this once the AutoFilter is applied. Leave your x=1 code since it seems to be working. Add an Else, though, to show a message box to the user that the best cell needs to be double-clicked.
VBA Code:
If x = 1 Then
    'your existing code
Else
    MsgBox "Double-click the cell with the best option"
End If

In the Code for the sheet with the AutoFilter (ItemRange?), add this code:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Filter is applied
    If Me.FilterMode Then
        
        'Prevent double-clicking from going into edit mode
        Cancel = True
        
        'Check to see if double-clicked cell is one of the filtered cells
        If Not Intersect(Range("A1").CurrentRegion.Offset(1).Resize(Range("A1").CurrentRegion.Rows.Count - 1), Target) Is Nothing Then
            'do the copy stuff
            Dim found As Range
            Set found = Rows(1).Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)
            Worksheets("Take Off...your INITIALS").Range("T9").Value = Cells(Target.Row, found.Column).Value
            
            'Turn off AutoFilter
            Me.ShowAllData
        End If
    End If
End Sub
If the sheet is not in filter mode, normal double-clicking applies. However, if the filter has been applied, double-clicking will not do anything unless one of the filtered rows is clicked. That row is the one that is copied to T9. Also, after the double-click/copy operation, the AutoFilter is removed.
 
Upvote 0
Solution
You could do something like this once the AutoFilter is applied. Leave your x=1 code since it seems to be working. Add an Else, though, to show a message box to the user that the best cell needs to be double-clicked.
VBA Code:
If x = 1 Then
    'your existing code
Else
    MsgBox "Double-click the cell with the best option"
End If

In the Code for the sheet with the AutoFilter (ItemRange?), add this code:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Filter is applied
    If Me.FilterMode Then
       
        'Prevent double-clicking from going into edit mode
        Cancel = True
       
        'Check to see if double-clicked cell is one of the filtered cells
        If Not Intersect(Range("A1").CurrentRegion.Offset(1).Resize(Range("A1").CurrentRegion.Rows.Count - 1), Target) Is Nothing Then
            'do the copy stuff
            Dim found As Range
            Set found = Rows(1).Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)
            Worksheets("Take Off...your INITIALS").Range("T9").Value = Cells(Target.Row, found.Column).Value
           
            'Turn off AutoFilter
            Me.ShowAllData
        End If
    End If
End Sub
If the sheet is not in filter mode, normal double-clicking applies. However, if the filter has been applied, double-clicking will not do anything unless one of the filtered rows is clicked. That row is the one that is copied to T9. Also, after the double-click/copy operation, the AutoFilter is removed.
This is a solid alternative to what I was trying to do originally. Thank you so much for your help! I apologize for the delay, I was pulled away temporarily and didn't have time to properly look at what you had replied with
 
Upvote 0
You could do something like this once the AutoFilter is applied. Leave your x=1 code since it seems to be working. Add an Else, though, to show a message box to the user that the best cell needs to be double-clicked.
VBA Code:
If x = 1 Then
    'your existing code
Else
    MsgBox "Double-click the cell with the best option"
End If

In the Code for the sheet with the AutoFilter (ItemRange?), add this code:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Filter is applied
    If Me.FilterMode Then
       
        'Prevent double-clicking from going into edit mode
        Cancel = True
       
        'Check to see if double-clicked cell is one of the filtered cells
        If Not Intersect(Range("A1").CurrentRegion.Offset(1).Resize(Range("A1").CurrentRegion.Rows.Count - 1), Target) Is Nothing Then
            'do the copy stuff
            Dim found As Range
            Set found = Rows(1).Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)
            Worksheets("Take Off...your INITIALS").Range("T9").Value = Cells(Target.Row, found.Column).Value
           
            'Turn off AutoFilter
            Me.ShowAllData
        End If
    End If
End Sub
If the sheet is not in filter mode, normal double-clicking applies. However, if the filter has been applied, double-clicking will not do anything unless one of the filtered rows is clicked. That row is the one that is copied to T9. Also, after the double-click/copy operation, the AutoFilter is removed.
By any chance do you know how I would get your code to update the "T9" cell to the cell row number given as variable "r" in my code? I've made r a public variable, but when I use the following:

VBA Code:
Worksheets("Take Off...your INITIALS").Range("T" & r).Value = Cells(Target.Row, found.Column).Value

It throws the error saying r is equal to 0. But I thought since I made r a public variable it could be used anywhere? Below is the code I have. I have all of this inside of a specific sheets code rather than a module. But as you will see once that sheet meets the criteria of having a cell in N be changed, it activates the other sheet which has the code you gave me earlier. Do you know what I am misunderstanding when trying to use the value of my variable r from the previous sheet?


VBA Code:
Public r As Long
Sub Worksheet_Change(ByVal Target As Range)
        Dim lastCol As Variant
        Dim lastRow As Variant
        Dim cel As Variant
        Dim test As Variant
        Dim iNum As Integer

If Not Intersect(Target, Range("N9:N16000")) Is Nothing Then
    r = Target.Row
    If IsEmpty(Range("S" & r).Value) = False And IsEmpty(Range("U" & r).Value) = False Then
        Sheet8.Activate
        'Call Filter_multi
        'Sub Filter_multi()

Set ItemRange = Application.InputBox("Select range of the Item/Component Column. Starting on row 2 of that column, drag it down to the last cell", "Obtain Range Object", Type:=8)
'With Sheets("Sheet2").Range("A1")
With ItemRange

    .AutoFilter field:=1, Criteria1:=(Worksheets("Take Off...your INITIALS").Range("N" & r).Text)
    .AutoFilter field:=5, Criteria1:=">=" & Worksheets("Take Off...your INITIALS").Range("U" & r).Value
    .AutoFilter field:=4, Criteria1:="<=" & Worksheets("Take Off...your INITIALS").Range("U" & r).Value
    If InStr(1, Worksheets("Take Off...your INITIALS").Range("S" & r).Text, ",", vbTextCompare) > 0 Then
    B4Comma = Left(Worksheets("Take Off...your INITIALS").Range("S" & r).Text, WorksheetFunction.Search(",", Worksheets("Take Off...your INITIALS").Range("S" & r).Text) - 1)
    AComma = Right(Worksheets("Take Off...your INITIALS").Range("S" & r).Text, WorksheetFunction.Search(",", Worksheets("Take Off...your INITIALS").Range("S" & r).Text))
    MsgBox (B4Comma & vbNewLine _
    & AComma)
    .AutoFilter field:=3, Criteria1:="*" & B4Comma & "*", Operator:=xlAnd, Criteria2:="*" & AComma & "*"
    Else
    .AutoFilter field:=3, Criteria1:="*" & (Worksheets("Take Off...your INITIALS").Range("S" & r).Text & "*")
    End If
    
    x = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Count
    MsgBox (x)
    
    lastCol = ItemRange.Cells(1, Columns.Count).End(xlToLeft).Column
    Set srcRow = ItemRange.Range("A1", ItemRange.Cells(1, lastCol))
    Set found = srcRow.Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)    
    lastRow = .Columns(found.Column).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
    Set test = Selection
    test.Copy
   
    
    If x = 1 Then
    lastCol = ItemRange.Cells(1, Columns.Count).End(xlToLeft).Column
    Set srcRow = ItemRange.Range("A1", ItemRange.Cells(1, lastCol))
    Set found = srcRow.Find(What:="Material", LookAt:=xlWhole, MatchCase:=False)
    MsgBox (found.Column & vbNewLine _
    & found.Address)
    
    lastRow = .Columns(found.Column).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
    Set test = Selection
    test.Copy Destination:=Worksheets("Take Off...your INITIALS").Range("T" & r)
  
    ActiveCell.Copy Destination:=Worksheets("Take Off...your INITIALS").Range("T" & r)
    
        End If
 
Upvote 0
Try adding the sheet name of the sheet with the public r variable. For example, you don't say what the sheet name is of the Worksheet_Change code, but if it is Sheet7, in the code for Sheet8 where you have r, try Range("T" & Sheet7.r).
 
Upvote 0
Try adding the sheet name of the sheet with the public r variable. For example, you don't say what the sheet name is of the Worksheet_Change code, but if it is Sheet7, in the code for Sheet8 where you have r, try Range("T" & Sheet7.r).
That was it! I was trying something like that earlier, but I was calling it. It turns out it really was as simple as just adding the sheet#! Thank you!
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,184
Members
452,615
Latest member
bogeys2birdies

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