none
I want to execute the VBA program automaticly when changing a cell or a cell range, I have tried with "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" but the program does not execute. RRS feed

  • Question

  • Sub Calculate_Options()
    
    Dim Metallization As Integer
    Dim Terminals As Integer
    Dim Coating As Integer
    
    Metallization = Range("H15").Value
    Terminals = Range("I15").Value
    Coating = Range("I14").Value
    
    If Metallization > 1 Then
     Range("I22:I26") = ""
     MsgBox "Please Select Only One Metalization Type with One Overspray", vbExclamation
    End If
    
    If Terminals > 1 Then
     Range("I28:I35") = ""
     MsgBox "Please Select Only One Terminal Type", vbExclamation
    End If
     
    If Coating > 1 Then
     Range("I36:I37") = ""
     MsgBox "Please Select Only One Coating Type", vbExclamation
    End If
    
    If Range("$I$27") = 1 Then
        Range("I23:I26") = ""
        MsgBox "Tin Already Includes Overspray", vbExclamation
    End If
    
    If Range("$I$28") = 1 Then
        Range("I23:I27") = ""
        MsgBox "Radial Clamp Already Includes Overspray and Tin", vbExclamation
    End If
    
    If Range("$H$21") = "NO" And Range("$I$21") = 1 Then
            Range("$I$21") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$22") = "NO" And Range("$I$22") = 1 Then
            Range("I22") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$23") = "NO" And Range("$I$23") = 1 Then
            Range("I23") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$24") = "NO" And Range("$I$24") = 1 Then
            Range("I24") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$25") = "NO" And Range("$I$25") = 1 Then
            Range("I25") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$26") = "NO" And Range("$I$26") = 1 Then
            Range("I26") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$27") = "NO" And Range("$I$27") = 1 Then
            Range("I27") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$28") = "NO" And Range("$I$28") = 1 Then
            Range("I28") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$29") = "NO" And Range("$I$29") = 1 Then
            Range("I29") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$30") = "NO" And Range("$I$30") = 1 Then
            Range("I30") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$31") = "NO" And Range("$I$31") = 1 Then
            Range("I31") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$32") = "NO" And Range("$I$32") = 1 Then
            Range("I32") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$33") = "NO" And Range("$I$33") = 1 Then
            Range("I33") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$34") = "NO" And Range("$I$34") = 1 Then
            Range("I34") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$35") = "NO" And Range("$I$35") = 1 Then
            Range("I35") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$36") = "NO" And Range("$I$36") = 1 Then
            Range("I36") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$37") = "NO" And Range("$I$36") = 1 Then
            Range("I37") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$38") = "NO" And Range("$I$36") = 1 Then
            Range("I38") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
       
        
    
    Dim Ohms As Double
    Ohms = Range("B12").Value
    
    
    If Ohms > 0 And Ohms < 10 Then
        Range("B14") = Round(Ohms, 1)
    ElseIf Ohms >= 10 And Ohms < 100 Then
        Range("B14") = Round(Ohms, 0)
    ElseIf Ohms >= 100 And Ohms < 1000 Then
        Range("B14") = Round(Ohms / 10, 0) * 10
    ElseIf Ohms >= 1000 And Ohms < 10000 Then
        Range("B14") = Round(Ohms / 100, 0) * 100
    ElseIf Ohms >= 10000 And Ohms < 100000 Then
        Range("B14") = Round(Ohms / 1000, 0) * 1000
    ElseIf Ohms >= 100000 And Ohms < 1000000 Then
        Range("B14") = Round(Ohms / 10000, 0) * 10000
    ElseIf Ohms >= 1000000 And Ohms < 10000000 Then
        Range("B14") = Round(Ohms / 100000, 0) * 100000
    End If
    
    
    End Sub
    Monday, November 7, 2016 6:30 PM

All replies

  • Hi,

    Worksheet_Change event is different than Worksheet_SelectionChange event. If you want your code to trigger on changing any cell or range then put your code under Worsheet_Change event.

    For Example: If you want your code to trigger on changing any value in cell "A1" then your code would look like this:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo err
    If Target.Address = "$A$1" Then
        Application.EnableEvents = False
           
        '<Type your code or call the function which you want to execute>
    
    End If
    
    err: Application.EnableEvents = False
    
    End Sub


    Vish Mishra

    Monday, November 7, 2016 8:03 PM
  • Hello

    Thanks for your reply

    I added the the code to a range of cells but when I change something nothing happens.

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo err
    If Target.Address = Range("$B$9:$B$13", "$I$21:$I$38") Then
        Application.EnableEvents = False
            
    Dim Metallization As Integer
    Dim Terminals As Integer
    Dim Coating As Integer
    
    Metallization = Range("H15").Value
    Terminals = Range("I15").Value
    Coating = Range("I14").Value
    
    If Metallization > 1 Then
     Range("I22:I26") = ""
     MsgBox "Please Select Only One Metalization Type with One Overspray", vbExclamation
    End If
    
    If Terminals > 1 Then
     Range("I28:I35") = ""
     MsgBox "Please Select Only One Terminal Type", vbExclamation
    End If
     
    If Coating > 1 Then
     Range("I36:I37") = ""
     MsgBox "Please Select Only One Coating Type", vbExclamation
    End If
    
    If Range("$I$27") = 1 Then
        Range("I23:I26") = ""
        MsgBox "Tin Already Includes Overspray", vbExclamation
    End If
    
    If Range("$I$28") = 1 Then
        Range("I23:I27") = ""
        MsgBox "Radial Clamp Already Includes Overspray and Tin", vbExclamation
    End If
    
    If Range("$H$21") = "NO" And Range("$I$21") = 1 Then
            Range("$I$21") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$22") = "NO" And Range("$I$22") = 1 Then
            Range("I22") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$23") = "NO" And Range("$I$23") = 1 Then
            Range("I23") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$24") = "NO" And Range("$I$24") = 1 Then
            Range("I24") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$25") = "NO" And Range("$I$25") = 1 Then
            Range("I25") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$26") = "NO" And Range("$I$26") = 1 Then
            Range("I26") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$27") = "NO" And Range("$I$27") = 1 Then
            Range("I27") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$28") = "NO" And Range("$I$28") = 1 Then
            Range("I28") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$29") = "NO" And Range("$I$29") = 1 Then
            Range("I29") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$30") = "NO" And Range("$I$30") = 1 Then
            Range("I30") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$31") = "NO" And Range("$I$31") = 1 Then
            Range("I31") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$32") = "NO" And Range("$I$32") = 1 Then
            Range("I32") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$33") = "NO" And Range("$I$33") = 1 Then
            Range("I33") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$34") = "NO" And Range("$I$34") = 1 Then
            Range("I34") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$35") = "NO" And Range("$I$35") = 1 Then
            Range("I35") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$36") = "NO" And Range("$I$36") = 1 Then
            Range("I36") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$37") = "NO" And Range("$I$36") = 1 Then
            Range("I37") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$38") = "NO" And Range("$I$36") = 1 Then
            Range("I38") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    
    '___________________________________________________________________________________________
    
        
    Dim Ohms As Double
    Ohms = Range("B12").Value
    
    
    If Ohms > 0 And Ohms < 10 Then
        Range("B14") = Round(Ohms, 1)
    ElseIf Ohms >= 10 And Ohms < 100 Then
        Range("B14") = Round(Ohms, 0)
    ElseIf Ohms >= 100 And Ohms < 1000 Then
        Range("B14") = Round(Ohms / 10, 0) * 10
    ElseIf Ohms >= 1000 And Ohms < 10000 Then
        Range("B14") = Round(Ohms / 100, 0) * 100
    ElseIf Ohms >= 10000 And Ohms < 100000 Then
        Range("B14") = Round(Ohms / 1000, 0) * 1000
    ElseIf Ohms >= 100000 And Ohms < 1000000 Then
        Range("B14") = Round(Ohms / 10000, 0) * 10000
    ElseIf Ohms >= 1000000 And Ohms < 10000000 Then
        Range("B14") = Round(Ohms / 100000, 0) * 100000
    End If
    
    End If
    
    err: Application.EnableEvents = False
    
    End Sub


    Monday, November 7, 2016 9:47 PM
  • Hi,

    My bad. When you have a single cell then you can directly compare but if you have got a range then you need to check by using Intersect method :

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo err
    If Not Intersect(Target, Range("$B$9:$B$13, $I$21:$I$38")) Is Nothing Then
        
    Application.EnableEvents = False
           
        '<Type your code or call the function which you want to execute>
    
    End If
    
    err: Application.EnableEvents = True
    
    End Sub

    May be enableEvents is set to false for your excel. To enable it follow the below steps and then try your code:

    Step 1: Go to your VBE screen

    Step 2: Press Control + G

    3. There will be a small winodow appearing named "Immediate window"

    4. Paste this and press enter - Application.EnableEvents=True

    After that you try to run the above changes I have suggested.


    Vish Mishra

    Monday, November 7, 2016 10:13 PM
  • Hi,

    Did it solve your problem? If yes kindly mark them as answered in order to make this forum neat. Thanks in advance.


    Vish Mishra

    Tuesday, November 8, 2016 9:02 AM
  • Hello Vish,

    Thanks for your help,  I made the changes you sugested but still won't activate the code when changing any cells on the excel spreadsheet.

    Private Sub Worksheet_Change(ByVal Target As Range)
    
            
    On Error GoTo err
    If Not Intersect(Target, Range("$B$9:$B$13, $I$21:$I$38")) Is Nothing Then
        
    Application.EnableEvents = False
            
    Dim Metallization As Integer
    Dim Terminals As Integer
    Dim Coating As Integer
    
    Metallization = Range("H15").Value
    Terminals = Range("I15").Value
    Coating = Range("I14").Value
    
    If Metallization > 1 Then
     Range("I22:I26") = ""
     MsgBox "Please Select Only One Metalization Type with One Overspray", vbExclamation
    End If
    
    If Terminals > 1 Then
     Range("I28:I35") = ""
     MsgBox "Please Select Only One Terminal Type", vbExclamation
    End If
     
    If Coating > 1 Then
     Range("I36:I37") = ""
     MsgBox "Please Select Only One Coating Type", vbExclamation
    End If
    
    If Range("$I$27") = 1 Then
        Range("I23:I26") = ""
        MsgBox "Tin Already Includes Overspray", vbExclamation
    End If
    
    If Range("$I$28") = 1 Then
        Range("I23:I27") = ""
        MsgBox "Radial Clamp Already Includes Overspray and Tin", vbExclamation
    End If
    
    If Range("$H$21") = "NO" And Range("$I$21") = 1 Then
            Range("$I$21") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$22") = "NO" And Range("$I$22") = 1 Then
            Range("I22") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$23") = "NO" And Range("$I$23") = 1 Then
            Range("I23") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$24") = "NO" And Range("$I$24") = 1 Then
            Range("I24") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$25") = "NO" And Range("$I$25") = 1 Then
            Range("I25") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$26") = "NO" And Range("$I$26") = 1 Then
            Range("I26") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$27") = "NO" And Range("$I$27") = 1 Then
            Range("I27") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$28") = "NO" And Range("$I$28") = 1 Then
            Range("I28") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$29") = "NO" And Range("$I$29") = 1 Then
            Range("I29") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$30") = "NO" And Range("$I$30") = 1 Then
            Range("I30") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$31") = "NO" And Range("$I$31") = 1 Then
            Range("I31") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$32") = "NO" And Range("$I$32") = 1 Then
            Range("I32") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$33") = "NO" And Range("$I$33") = 1 Then
            Range("I33") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$34") = "NO" And Range("$I$34") = 1 Then
            Range("I34") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$35") = "NO" And Range("$I$35") = 1 Then
            Range("I35") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$36") = "NO" And Range("$I$36") = 1 Then
            Range("I36") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$37") = "NO" And Range("$I$36") = 1 Then
            Range("I37") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    If Range("$H$38") = "NO" And Range("$I$36") = 1 Then
            Range("I38") = ""
            MsgBox "Option Not Available for This Part Number", vbExclamation
       End If
    
    '___________________________________________________________________________________________
    
        
    Dim Ohms As Double
    Ohms = Range("B12").Value
    
    
    If Ohms > 0 And Ohms < 10 Then
        Range("B14") = Round(Ohms, 1)
    ElseIf Ohms >= 10 And Ohms < 100 Then
        Range("B14") = Round(Ohms, 0)
    ElseIf Ohms >= 100 And Ohms < 1000 Then
        Range("B14") = Round(Ohms / 10, 0) * 10
    ElseIf Ohms >= 1000 And Ohms < 10000 Then
        Range("B14") = Round(Ohms / 100, 0) * 100
    ElseIf Ohms >= 10000 And Ohms < 100000 Then
        Range("B14") = Round(Ohms / 1000, 0) * 1000
    ElseIf Ohms >= 100000 And Ohms < 1000000 Then
        Range("B14") = Round(Ohms / 10000, 0) * 10000
    ElseIf Ohms >= 1000000 And Ohms < 10000000 Then
        Range("B14") = Round(Ohms / 100000, 0) * 100000
    End If
    
    End If
    
    
    err: Application.EnableEvents = True
    
    End Sub


    Tuesday, November 8, 2016 2:41 PM
  • Hi,

    Where are you putting the above code? I hope you are putting it under that particular sheet's VBE screen and not in Module or any other sheet's Worksheet_Change event.


    Vish Mishra

    Tuesday, November 8, 2016 2:53 PM
  • Hi,

    Mark it as answered if your problem is resolved by above code. This is in order to keep this forum clean.


    Vish Mishra

    Tuesday, November 15, 2016 3:46 PM