Multiple BeforeDoubleClick-CodePudding

I have two BeforeDoublceClick events which i need help amalgamating, please can someone help me?

I want to amalgamate

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column <> 1 Then Exit Sub
   Dim last As Long
   last = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
   Sheet2.Range("A6:P" & last).AutoFilter
   Sheet2.Range("A6:P" & last).AutoFilter Field:=1, Criteria1:=Target.Value
   Cancel = True
   Application.Goto Sheet2.Range("A1")
End Sub

and

If Target.Column <> 2 Then Exit Sub
    Dim last As Long
    last = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
    Sheet1.Range("A6:AQ" & last).AutoFilter
    Sheet1.Range("B6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
    Cancel = True
    Application.Goto Sheet1.Range("B7")
End Sub

CodePudding user response：

The two codes are basically the same except the goto at the end, right?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not (Target.Column = 1 Or Target.Column = 2) Then Exit Sub
    Dim last As Long
    last = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
    Sheet1.Range("A6:AQ" & last).AutoFilter
    Sheet1.Range("A6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
    Cancel = True
    If Target.Column = 1 Then 
        Application.Goto Sheet1.Range("A1")
    Else
        Application.goto Sheet1.range("B7")
    End if

End Sub

CodePudding user response：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim last As Long
    If Target.Column = 1 Then
        last = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
        Me.Range("A6:AQ" & last).AutoFilter
        Me.Range("A6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
        Cancel = True
        Application.Goto Me.Range("A1")
    ElseIf Target.Column = 2 Then
        last = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
        Me.Range("A6:AQ" & last).AutoFilter
        Me.Range("B6:AQ" & last).AutoFilter Field:=1, Criteria1:=Target.Value
        Cancel = True
        Application.Goto Sheet1.Range("B7")
    End If
End Sub