VBA Conundrum

[Marc Wylie]

Hi All,

I am trying to write a VBA program which activates on a change within a cell which is a drop down list.

I want the program to identify the text in the cell (D2) and based on the text content and the value in another cell (A2) insert a value into cell E2.

I have tried Select Case and If Then but I am getting nowhere.

At the moment this is what I have:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("D2") Then
If Range("D2").Value = "Cat I(a)" And Range("A2").Value = "1" Then Range("E2").Select
ActiveCell.FormulaR1C1 = "1"
End If
End Sub

I am wasting hours getting nowhere, and need to expand this program multiple times for different variables and then into different cell ranges but I am stuck right at the starting block.

I am a VBA newbie, and I guess I am going in pretty hard but its a tool I am producing for my MSc Dissertation so I just need to get my head round it and get on.

Many thanks for your time.

Marc

 

[FormR]

I think this maybe what you are looking for:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" Then
    Application.EnableEvents = False
        If Target.Value = "Cat I(a)" And Range("A2").Value = 1 Then Target.Offset(, 1).Value = 1
    Application.EnableEvents = True
End If
End Sub

 

[Marc Wylie]

I think this maybe what you are looking for:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$2" Then
    Application.EnableEvents = False
        If Target.Value = "Cat I(a)" And Range("A2").Value = 1 Then Target.Offset(, 1).Value = 1
    Application.EnableEvents = True
End If
End Sub

Hi, thank you. I have copied it in unfortunately still no 1 appearing in my E1 column.

Also two questions if I may?

1. What are the two Application.EnableEvents lines for?

2. And do you think that the issue could be because the change event is a selection from a list rather than a physical input to the cell?

Thank you again for taking the time to try and help me out

Marc

 

[FormR]

Also two questions if I may?

Sure.

1) It temporarily disables events to prevent the code from calling itself when it makes the change to cell E3 and then turns it back on again after.

2) No, I don't think that is the problem but can you confirm that you are manually choosing the item from the list and that "list" is generated using data validation.

To help trouble shoot:

If you put these two formulas into blank cells on the sheet do they return TRUE?

=A2=1
=EXACT(D2,"Cat I(a)")

 

[Marc Wylie]

Hey,

Ok so I got it to work for Cat I(a).

I'm really sorry to keep asking questions like this, but I feel it going to take me a lifetime to fathom out the intricacies on my own.

The full problem is this:

Cell D2 has a drop down list containing a choice of six categories created using the data validation list option. They are as follows:

Cat I(a)
Cat I(b)
Cat I(c)
Cat I(d)
Cat II
Cat III

The cell within A2 contains an identifier number between 1 and 46.

Dependant upon the category selected I want a different value (or score if you like) to be presented in cell E2. So for example for the identifier number being 1 the different category choices should return as follows:

Cat I(a) = 1
Cat I(b) = 3
Cat I(c) = 7
Cat I(d) = 17
Cat II = 27
Cat III = 37

I need to make the form work for all the different combinations, and I also need to copy the code to activate the same way for cells D2:D23.

If Then may not be the way, Select Case might be? I'm more than willing to put in the time and effort to get it to work, but I feel like I am working blind at the moment.

Thanks again for your time.

Marc

 

[FormR]

Ok so I got it to work for Cat I(a).

Great, progress is being made

So for example for the identifier number being 1 the different category choices should return as follows:

So what is returned when the identifier number is one of the numbers between 2 and 46?

 

[Marc Wylie]

So what is returned when the identifier number is one of the numbers between 2 and 46?

The categories are weight categories for aircraft

Cat I(a) = 0-200g
Cat I(b) = 200g - 2kg
Cat I(c) = 2kg - 20kg
Cat I(d) = 20kg - 150kg
Cat II = 150kg - 600kg
Cat III = 600kg - 2000kg

I have split the weight categories down further for each one as follows (this is he identifier)

Cat I(a) = 1,2
Cat I(b) = 3,4,5,6
Cat I(c) = 7,8,9,10,11,12,13,14,15,16
Cat I(d) = 17,18...26
Cat II = 27,28...36
Cat III = 37,38...46

The weight category is the baseline, then dependant upon the risk the system poses in terms of its use may determine a shift up to a different category. The category it falls nto determines the weight of the regulation the operators of the system must adhere to. Mitigating factors such as safety of design can also lead to a drop in the category.

So for cat I(a) the only way is up and the increases will go to the bottom of the next category so (1,3,7,17,27,37)
but in the example of a cat III system the only way is down so it would fall into the top of each category (2,6,16,26 and its baseline identifier between 37 and 46)
The same will be true for the cats below so a Cat I(d) system with an identifier of 19 would have the options of (2,6,16,19,27,37)

I've worked out the permutations and they are pretty huge hence the need for a programme to determine it. There is some other bits I need to do with formulas (adding a weighting to each factor and then averaging the results) but this problem is the key to my dissertation.

Hope that has made it clearer than mud but if not ask away.

Marc

 

[Marc Wylie]

oh yeah and just to add the 22 rows between D2 and D23 are the regulation applied, so basically you are looking at a risk posed, looking at the baseline weight and determining the appropriate regulation. Dependant upon the weighting given to each risk and the regulation and the average of the scores will ultimately determine whether the systems stays in its original weight category and regulatory regime or shifts to a higher or lower category and has more or less regulation imposed.

Its a good tricky problem, and perfect for my dissertation (and helpful for my work too)

 

[mikerickson]

Dim ArrayOfValues(1 to 6, 1 to 10)
Dim i As Long

ArrayOfValues(1,1) = 1: ArrayOfValue(1,2) = 2
ArrayOfValues(2,1) = 3: ArrayOfValues(2,2) = 3: ArrayOfValues(2,3) = 4: ArrayOfValues(2,4) = 5:ArrayOfValues(2,5) = 6
For i = 1 to 10
    ArrayOfValues(3, i) = 6+i
    ArrayOfValues(4, i) = 16+i
    ArrayOfValues(5, i) = 26+i
    ArrayOfValues(6, i) = 36+i
Next i

With Target
    If .Cells.Count = 1 Then
        If Not Application.Insersect(Target, Range("A2:A23","D2:D23")) Is Nothing
            With .EntireRow
                .Range("E1").Value = ArrayOfValues(Application.Match(.Range("D1".Value, Array("Cat I(a)", "Cat I(b)", "Cat I(c)", "Cat I(d)", "Cat II", "Cat III"), 0), .Range("A1"))
            End With
        End If
    End If
End With

 

[Marc Wylie]

Dim ArrayOfValues(1 to 6, 1 to 10)
Dim i As Long

ArrayOfValues(1,1) = 1: ArrayOfValue(1,2) = 2
ArrayOfValues(2,1) = 3: ArrayOfValues(2,2) = 3: ArrayOfValues(2,3) = 4: ArrayOfValues(2,4) = 5:ArrayOfValues(2,5) = 6
For i = 1 to 10
    ArrayOfValues(3, i) = 6+i
    ArrayOfValues(4, i) = 16+i
    ArrayOfValues(5, i) = 26+i
    ArrayOfValues(6, i) = 36+i
Next i

With Target
    If .Cells.Count = 1 Then
        If Not Application.Insersect(Target, Range("A2:A23","D2:D23")) Is Nothing
            With .EntireRow
                .Range("E1").Value = ArrayOfValues(Application.Match(.Range("D1".Value, Array("Cat I(a)", "Cat I(b)", "Cat I(c)", "Cat I(d)", "Cat II", "Cat III"), 0), .Range("A1"))
            End With
        End If
    End If
End With

Option Explicit
Dim ArrayOfValues(1 To 6, 1 To 10)
Dim i As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$D$2" Then
        ArrayOfValues(1, 1) = 1: ArrayOfValues(1, 2) = 2: ArrayOfValues(2, 1) = 3: ArrayOfValues(2, 2) = 3: ArrayOfValues(2, 3) = 4: ArrayOfValues(2, 4) = 5: ArrayOfValues(2, 5) = 6
                
                For i = 1 To 10
                    ArrayOfValues(3, i) = 6 + i
                    ArrayOfValues(4, i) = 16 + i
                    ArrayOfValues(5, i) = 26 + i
                    ArrayOfValues(6, i) = 36 + i
                    Next i

                        With Target
                            If .Cells.Count = 1 Then
                                If Not Application.Insersect(Target, Range("A2:A23", "D2:D23")) Is Nothing Then With .EntireRow.Range("E1").Value = ArrayOfValues(Application.Match(.Range("D1").Value, Array("Cat I(a)", "Cat I(b)", "Cat I(c)", "Cat I(d)", "Cat II", "Cat III"), 0), .Range("A1"))
                    
                        End With
                   End If
                End If
         End With
End Sub

Hi MikeRickerson, thankyou for trying to help out.

I have entered it as above, but I get a compile error: End If without Block If coming up highlighting on the "If Not" line?

Any Ideas?

Many Thanks

Marc