AutoFilter Results into a user Selection

[nmbc99]

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

Spec	MOC	ITEM	Smaller	Bigger	RATING	ENDS	MATERIAL
FB74	FRP	Pipe (Notes 1, 2, 3)	3.00​	4.00​	150 psi	Plain End	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
FB74	FRP	Pipe (Notes 1, 2, 3)	4.00​	14.00​	100 psi	Plain End (Butt Wrap)	NOV Fiber Glass Systems, F‐Chem FRP Pipe, Filament Wound, 100‐mil Vinyl Ester Resin Liner.
FB74	FRP	Pipe Support Cradle	1.00​	14.00​	N/A	N/A	NOV 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

Spec	MOC	ITEM	Smaller	Bigger	SIZE (NPS)	RATING	ENDS	MATERIAL
FB74	FRP	Pipe (Notes 1, 2, 3)	3.00​	4.00​	3” to 4” (80mm to 100mm)	150 psi	Plain End	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
FB74	FRP	Pipe (Notes 1, 2, 3)	4.00​	14.00​	4” to 14” (100mm to 350mm) *Forbranchconnections onF‐Chemheaders	100 psi	Plain End (Butt Wrap)	NOV Fiber Glass Systems, F‐Chem FRP Pipe, Filament Wound, 100‐mil Vinyl Ester Resin Liner.
FB74	FRP	Pipe Support Cradle	1.00​	14.00​	1” to 14” (25mm to 350mm)	N/A	N/A	NOV 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.

 

[shknbk2]

The material information you want copied is copied where? To the clipboard? To a cell?

 

[nmbc99]

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:

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.

 

[shknbk2]

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.

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:

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.

 

[nmbc99]

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.

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:

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

 

[nmbc99]

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.

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:

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:

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?

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

 

[shknbk2]

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).

 

[nmbc99]

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!