Multiple ranges on before double click help!!

S

Swifty87

New Member
Joined
Oct 23, 2019
Messages
18
Hey Guys,

I have the below CODE EG.1 VBA on one of my WorkSheets that works well, however, when I try to add in a second range into the code for a second action on a double click on any cell in the range N12:N100 I can not make it work!! The code I am looking to add would be as shown in CODE EG.2 I have been on google for the past couple of hours but no matter what I try I can't get it to work. How would one combine these two together :)?

Really appreciate any and all help

CODE EG.1
VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("F12:F40")) Is Nothing Then
        Cancel = True
        
'MESSAGE NOTIFICATION
        Dim Title   As String
        Dim Message As String
        Dim PauseTime As Integer
        Dim WScriptShell As Object
        Dim ConfigString As String
        Dim strplant As String
        
        Message = "Sheet Is pulling in the BOM For " & Target.Value & " This can ake 1-2min"
        PauseTime = 5
        Title = "BOM DATA"
        Set WScriptShell = CreateObject("WScript.Shell")
        ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
        "Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
        WScriptShell.Run ConfigString
        
'END OF MESSAGE NOTIFICATION
        
        Worksheets("DATA Hold").Range("R3").Value = Target.Value
        Worksheets("DATA Hold").Range("S3").Value = Target.Offset(0, -1).Value
        Range("N12:AN12").Select
        Selection.AutoFill Destination:=Range("N12:AN102"), Type:=xlFillDefault
        Range("N12:AN102").Select
        Range("N13:AN102").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("D10:K10").Select
        
        MsgBox "BOM For " & Target.Value & " Ready For Review", vbOK + vbInformation, "Complete"
    End If
    
' NEXT ARGUMENT FOR WO LOOKUP

    If Not Intersect(Target, Range("Q12:Q100")) Is Nothing Then
        Cancel = True
        Worksheets("DATA Hold").Range("R4").Value = Target.Value
        WO = Target.Value
        strplant = Sheets("DATA Hold").Range("R5").Value
        Dim Answer  As VbMsgBoxResult
        
        Answer = MsgBox("Would you Like To view the Order in SAP?", vbYesNo + vbQuestion, "Open SAP Order Details")
        If Answer = vbYes Then
            GetSAPWO (WO)
            Dim Answerb As VbMsgBoxResult
            Answerb = MsgBox("Would you Like To view the Operation Booking Analysis?", vbYesNo + vbQuestion, "Open SAP Bookings")
            If Answerb = vbYes Then
                GetSAPWOops (WO), (strplant)
                Call Op_Hours
            End If
        Else
            MsgBox "No problem, To view Details please Double click Covered By number"
        End If
    End If
    
End Sub



CODE EG.2

VBA Code: 
If Not Intersect(Target, Range("N12:N100")) Is Nothing Then
    Cancel = True
    Worksheets("DATA Hold").Range("R8").Value = Target.Value
    MTL = Target.Value
    strplant = Sheets("DATA Hold").Range("R5").Value
    
    Dim Answerc As VbMsgBoxResult
    Answerc = MsgBox("Would you like to view the previous costs in SAP?", vbYesNo + vbQuestion, "Open SAP Cost Details")
    If Answerc = vbYes Then
        GetSAPCost (MTL), (strplant)
    End If
Else
    MsgBox "No problem, To view Details please Double click Material Number"
End If
End If

End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
You have one too many End If lines there
 
Upvote 0
Hey Thanks,

Even tweaking it I still can't get it to run, will be something stupid I am doing but can't figure out have tried adding after Else, and as below using Else If. or going direct after End if removing the Else completely! My VBA knowledge is not great I manage by cobbling together things I get from google and youtube


VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("F12:F40")) Is Nothing Then
        Cancel = True
       
'MESSAGE NOTIFICATION
        Dim Title   As String
        Dim Message As String
        Dim PauseTime As Integer
        Dim WScriptShell As Object
        Dim ConfigString As String
        Dim strplant As String
       
        Message = "Sheet Is pulling in the BOM For " & Target.Value & " This can ake 1-2min"
        PauseTime = 5
        Title = "BOM DATA"
        Set WScriptShell = CreateObject("WScript.Shell")
        ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
        "Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
        WScriptShell.Run ConfigString
       
'END OF MESSAGE NOTIFICATION
       
        Worksheets("DATA Hold").Range("R3").Value = Target.Value
        Worksheets("DATA Hold").Range("S3").Value = Target.Offset(0, -1).Value
        Range("N12:AN12").Select
        Selection.AutoFill Destination:=Range("N12:AN102"), Type:=xlFillDefault
        Range("N12:AN102").Select
        Range("N13:AN102").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("D10:K10").Select
       
        MsgBox "BOM For " & Target.Value & " Ready For Review", vbOK + vbInformation, "Complete"
    End If
   
' NEXT ARGUMENT FOR WO LOOKUP

    If Not Intersect(Target, Range("Q12:Q100")) Is Nothing Then
        Cancel = True
        Worksheets("DATA Hold").Range("R4").Value = Target.Value
        WO = Target.Value
        strplant = Sheets("DATA Hold").Range("R5").Value
        Dim Answer  As VbMsgBoxResult
       
        Answer = MsgBox("Would you Like To view the Order in SAP?", vbYesNo + vbQuestion, "Open SAP Order Details")
        If Answer = vbYes Then
            GetSAPWO (WO)
            Dim Answerb As VbMsgBoxResult
            Answerb = MsgBox("Would you Like To view the Operation Booking Analysis?", vbYesNo + vbQuestion, "Open SAP Bookings")
            If Answerb = vbYes Then
                GetSAPWOops (WO), (strplant)
                Call Op_Hours
            End If
       
            ElseIf Not Intersect(Target, Range("N12:N40")) Is Nothing Then
        Cancel = True
       
'        If Not Intersect(Target, Range("N12:N100")) Is Nothing Then
'    Cancel = True
    Worksheets("DATA Hold").Range("R8").Value = Target.Value
    MTL = Target.Value
    strplant = Sheets("DATA Hold").Range("R5").Value
   
    Dim Answerc As VbMsgBoxResult
    Answerc = MsgBox("Would you like to view the previous costs in SAP?", vbYesNo + vbQuestion, "Open SAP Cost Details")
    If Answerc = vbYes Then
    MsgBox ("It worked!!")
        'GetSAPCost (MTL), (strplant)
    End If
Else
''    MsgBox "No problem, To view Details please Double click Material Number"
End If

End If

   
End Sub
 
Upvote 0
Guessing slightly at the logic, but I suspect you want:

VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("F12:F40")) Is Nothing Then
        Cancel = True
        
'MESSAGE NOTIFICATION
        Dim Title   As String
        Dim Message As String
        Dim PauseTime As Integer
        Dim WScriptShell As Object
        Dim ConfigString As String
        Dim strplant As String
        
        Message = "Sheet Is pulling in the BOM For " & Target.Value & " This can ake 1-2min"
        PauseTime = 5
        Title = "BOM DATA"
        Set WScriptShell = CreateObject("WScript.Shell")
        ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
        "Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
        WScriptShell.Run ConfigString
        
'END OF MESSAGE NOTIFICATION
        
        Worksheets("DATA Hold").Range("R3").Value = Target.Value
        Worksheets("DATA Hold").Range("S3").Value = Target.Offset(0, -1).Value
        Range("N12:AN12").Select
        Selection.AutoFill Destination:=Range("N12:AN102"), Type:=xlFillDefault
        Range("N12:AN102").Select
        Range("N13:AN102").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("D10:K10").Select
        
        MsgBox "BOM For " & Target.Value & " Ready For Review", vbOK + vbInformation, "Complete"
    End If
    
' NEXT ARGUMENT FOR WO LOOKUP

    If Not Intersect(Target, Range("Q12:Q100")) Is Nothing Then
        Cancel = True
        Worksheets("DATA Hold").Range("R4").Value = Target.Value
        WO = Target.Value
        strplant = Sheets("DATA Hold").Range("R5").Value
        Dim Answer  As VbMsgBoxResult
        
        Answer = MsgBox("Would you Like To view the Order in SAP?", vbYesNo + vbQuestion, "Open SAP Order Details")
        If Answer = vbYes Then
            GetSAPWO (WO)
            Dim Answerb As VbMsgBoxResult
            Answerb = MsgBox("Would you Like To view the Operation Booking Analysis?", vbYesNo + vbQuestion, "Open SAP Bookings")
            If Answerb = vbYes Then
                GetSAPWOops (WO), (strplant)
                Call Op_Hours
            End If
        Else
            MsgBox "No problem, To view Details please Double click Covered By number"
        End If
    End If
    
    If Not Intersect(Target, Range("N12:N100")) Is Nothing Then
       Cancel = True
       Worksheets("DATA Hold").Range("R8").Value = Target.Value
       MTL = Target.Value
       strplant = Sheets("DATA Hold").Range("R5").Value
       
       Dim Answerc As VbMsgBoxResult
       Answerc = MsgBox("Would you like to view the previous costs in SAP?", vbYesNo + vbQuestion, "Open SAP Cost Details")
       If Answerc = vbYes Then
           GetSAPCost (MTL), (strplant)
      Else
          MsgBox "No problem, To view Details please Double click Material Number"
      End If
   End If
End Sub
 
Upvote 0
Solution
RoryA said:
Guessing slightly at the logic, but I suspect you want:

VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("F12:F40")) Is Nothing Then
        Cancel = True
       
'MESSAGE NOTIFICATION
        Dim Title   As String
        Dim Message As String
        Dim PauseTime As Integer
        Dim WScriptShell As Object
        Dim ConfigString As String
        Dim strplant As String
       
        Message = "Sheet Is pulling in the BOM For " & Target.Value & " This can ake 1-2min"
        PauseTime = 5
        Title = "BOM DATA"
        Set WScriptShell = CreateObject("WScript.Shell")
        ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
        "Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
        WScriptShell.Run ConfigString
       
'END OF MESSAGE NOTIFICATION
       
        Worksheets("DATA Hold").Range("R3").Value = Target.Value
        Worksheets("DATA Hold").Range("S3").Value = Target.Offset(0, -1).Value
        Range("N12:AN12").Select
        Selection.AutoFill Destination:=Range("N12:AN102"), Type:=xlFillDefault
        Range("N12:AN102").Select
        Range("N13:AN102").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("D10:K10").Select
       
        MsgBox "BOM For " & Target.Value & " Ready For Review", vbOK + vbInformation, "Complete"
    End If
   
' NEXT ARGUMENT FOR WO LOOKUP

    If Not Intersect(Target, Range("Q12:Q100")) Is Nothing Then
        Cancel = True
        Worksheets("DATA Hold").Range("R4").Value = Target.Value
        WO = Target.Value
        strplant = Sheets("DATA Hold").Range("R5").Value
        Dim Answer  As VbMsgBoxResult
       
        Answer = MsgBox("Would you Like To view the Order in SAP?", vbYesNo + vbQuestion, "Open SAP Order Details")
        If Answer = vbYes Then
            GetSAPWO (WO)
            Dim Answerb As VbMsgBoxResult
            Answerb = MsgBox("Would you Like To view the Operation Booking Analysis?", vbYesNo + vbQuestion, "Open SAP Bookings")
            If Answerb = vbYes Then
                GetSAPWOops (WO), (strplant)
                Call Op_Hours
            End If
        Else
            MsgBox "No problem, To view Details please Double click Covered By number"
        End If
    End If
   
    If Not Intersect(Target, Range("N12:N100")) Is Nothing Then
       Cancel = True
       Worksheets("DATA Hold").Range("R8").Value = Target.Value
       MTL = Target.Value
       strplant = Sheets("DATA Hold").Range("R5").Value
      
       Dim Answerc As VbMsgBoxResult
       Answerc = MsgBox("Would you like to view the previous costs in SAP?", vbYesNo + vbQuestion, "Open SAP Cost Details")
       If Answerc = vbYes Then
           GetSAPCost (MTL), (strplant)
      Else
          MsgBox "No problem, To view Details please Double click Material Number"
      End If
   End If
End Sub
Click to expand...
Worked brilliantly thanks!! and I think I can see where I was going wrong with the End If in the wrong places! I will keep a note for future
 
Upvote 0
You must log in or register to reply here.

Similar threads

JenniferMurphy
  • Question Question
Comments on macro to help solve the problem of Excel changing column widths
2
Replies
11
Views
336
JenniferMurphy
JenniferMurphy
H
  • Solved
Double Click Cell to cell to Sheet Name and Cell
2
Replies
11
Views
811
howard
H
J
  • Solved
multiple values
Replies
2
Views
397
JOEE1979
J
J
  • Solved
List all Items in Named Range in MsgBox
2
Replies
15
Views
577
johnny51981
J
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
752
sspatriots
S

Forum statistics

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

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