Impact Effort Matrix

[Brew]

Hello all

I need help with my Impact Effort Matrix. The records results in column C and D starting at row 5 is my Impact and Effort results. see the sample chart below.

I would like to do 2 things

How do I create a formula for my chart starting F5 where it will address all of the following conditions and give me the appropriate results and add a color for condition and its matching results in column F:
If C= 4 or 5 and D=4 or 5, then HighImpact-Hard
If C= 1 or 2 and D=4 or 5, then LowImpact-Hard
If C= 4 or 5 and D=1 or 2, then HighImpact-Easy
If C= 1 or 2 and D=1 or 2, then LowImpact-Easy
If C= 3 and D=1 or 2, then NeutralImpact-Easy
If C= 3 and D=4 or 5, then NeutralImpact-hard
If C= 4 or 5 and D=3, then HighImpact-NeutralEffort
If C= 1 or 2 and D=3, then LowImpact-NeutralEffort

Also, to the right of my table B5 to E94 is there a way to create a 4 quadrant plot, where the top left is the highImpact-hard, the bottom left= LowImpact-hard, the top right=highimpact-Easy, the bottom right= lowimpact-Easy and place the cell number in column B that matches the records condition in column C&D into the appropriate quadrant. row 5 is the first record. row 4 is the heading row.

Ideas Impact Effort Total
1) Buy Local and Direct from Producers 5 3 8
2) Share your Knowledge & Enthusiasm for Local Food 3 3 6
3) Join a Community Supported Agriculture (CSA) Program 1 5 6
4) Network Home Gardeners 5 2 7
5) Add Value to Your Own Agricultural Products 4 3 7
6) Identify Opportunities for Local Distribution 5 4 9
7) Find Ways to Pool Resources & Costs with Others 5 3 8
8) Network Community-Based Farmers 5 3 8
9) Create Incentives for Consumers to Shop Locally 5 2 7

 

[dreid1011]

Oh, I suppose I forgot to mention that part wasn't apart of the code. I assumed you had some borders set up. I can add some code to make the plot area, for my testing I just added some borders to the range K5:AD44 and named the quadrants.

 

[Brew]

Oh I see, What i was really looking for what for the results to auto-populate in the plot and if there are duplicates i could highlight column B record and that would highlight the plot result on the plot where i can adjust manually the location on the plot.

 

[dreid1011]

Oh I see, What i was really looking for what for the results to auto-populate in the plot and if there are duplicates i could highlight column B record and that would highlight the plot result on the plot where i can adjust manually the location on the plot.

Ah, I see. Ok, I can work that in.. but before I do, let me run it by you and tell me if it will be ok.

Currently, you have two buttons and some code to highlight the locations on the plot if you select an item in column B. The plot button generates a list of shapes in column A to be moved into the plot in K5:AD44. The clear button removes all shapes from the sheet.

You would like the plot button to auto populate the chart, but highlight duplicates so you can manually adjust them.

What I can do is auto populate the chart with non duplicates, then the duplicates will be created in column A next to their values in column B and highlight the value in column B. Then, you can click on the value in column B and it will highlight the position in the chart that item should go to (as it does currently).

Will this work for you?

 

[Brew]

Yes, i think that is acceptable. Thanks

 

[dreid1011]

Ok, and I apologize for the delay, I was out 3 days last week.

 

[Brew]

Ok thats fine. I overstand.
Thanks for the update.

 

[dreid1011]

Ok, replace all the code sections I gave you previously with these updated versions:

Private Sub PlotButton_Click()
Dim tB1 As Shape
Dim ws As Worksheet
Dim i As Long, j As Long, k As Long
Dim xVal As Variant, yVal As Variant, tBCheck As Variant
Dim dupeCheck As Boolean
dupeCheck = False
'Set the sheet name
Set ws = Worksheets("Impact Matrix")
'Define the significant coordinates of the chart (ignore first entries of "0", they are place holders)
xVal = Split("0,37,29,21,13,5", ",")
yVal = Split("0,K,O,S,W,AA", ",")
'Identify last row of data in column B
j = ws.Range("B" & Rows.Count).End(xlUp).Row
ReDim tBCheck(0 To j) As Variant
'Create labels and borders for the plot chart
If Range("K5").Value <> "HighImpact-Hard" Then
    With Range("K5:T24").Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K5:T24").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K5:T24").Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K5:T24").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("U5:AD24").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("U5:AD24").Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("U5:AD24").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K25:T44").Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K25:T44").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K25:T44").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("U25:AD44").Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("U25:AD44").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Range("K5")
        .Value = "HighImpact-Hard"
        .HorizontalAlignment = xlLeft
        .Font.Bold = True
        .Font.Italic = True
    End With
    With Range("AD5")
        .Value = "HighImpact-Easy"
        .HorizontalAlignment = xlRight
        .Font.Bold = True
        .Font.Italic = True
    End With
    With Range("K44")
        .Value = "LowImpact-Hard"
        .HorizontalAlignment = xlLeft
        .Font.Bold = True
        .Font.Italic = True
    End With
    With Range("AD44")
        .Value = "LowImpact-Easy"
        .HorizontalAlignment = xlRight
        .Font.Bold = True
        .Font.Italic = True
    End With
End If
'Loop through B5 to last row of data in column B
For i = 5 To j
'Create shapes and auto populate chart except for duplicates
If i >= 6 Then
    For k = i - 1 To 5 Step -1
        If Range("C" & i).Value = Range("C" & k).Value And Range("D" & i).Value = Range("D" & k).Value And tBCheck(i) <> 1 Then
            Set tB1 = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, Range("A" & i).Left + 10, Range("A" & i).Top, 30, 15)
            Range("B" & i).Interior.ColorIndex = 6
            With tB1.TextFrame
                .Characters.Text = ws.Range("B" & i).Address(0, 0)
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
                .Characters.Font.Size = 8
            End With
            tB1.Fill.ForeColor.RGB = RGB(204, 204, 204)
            tB1.Line.ForeColor.RGB = RGB(0, 0, 0)
            dupeCheck = True
            tBCheck(i) = 1
        End If
    Next k
End If
If dupeCheck = False And tBCheck(i) <> 1 Then
    Set tB1 = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, Range(yVal(Range("D" & i).Value) & xVal(Range("C" & i).Value)).Offset(3, 1).Left + 16, Range(yVal(Range("D" & i).Value) & xVal(Range("C" & i).Value)).Offset(3, 1).Top + 8, 30, 15)
    With tB1.TextFrame
        .Characters.Text = ws.Range("B" & i).Address(0, 0)
        .HorizontalAlignment = xlHAlignCenter
        .VerticalAlignment = xlVAlignCenter
        .Characters.Font.Size = 8
    End With
    tB1.Fill.ForeColor.RGB = RGB(204, 204, 204)
    tB1.Line.ForeColor.RGB = RGB(0, 0, 0)
    tBCheck(i) = 1
End If
dupeCheck = False
Next i
End Sub

Private Sub ClearButton_Click()
Dim shp As Shape
'Delete all shapes on the active sheet
For Each shp In ActiveSheet.Shapes
    If shp.Type = msoAutoShape Or shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long
Dim xVal As Variant, yVal As Variant
'Set the sheet name
Set ws = Worksheets("Impact Matrix")
'Identify last row of data in column B
i = ws.Range("B" & Rows.Count).End(xlUp).Row
'Define the significant coordinates of the chart (ignore first entries of "0", they are place holders)
xVal = Split("0,37,29,21,13,5", ",")
yVal = Split("0,K,O,S,W,AA", ",")
'Checks to see if you selected any cell within the used range in column B, then identifies the coordinates based on the values in columns C and D
If Target.Count > 1 Then
    Exit Sub
Else
    If Not Intersect(Target, ws.Range("B5:B" & i)) Is Nothing Then
        If Target.Interior.ColorIndex = 6 Then Target.Interior.ColorIndex = xlNone
        ws.Range("K5:AD44").Interior.ColorIndex = xlNone
        ws.Range(yVal(Target.Offset(, 2).Value) & xVal(Target.Offset(, 1).Value)).Resize(8, 4).Interior.ColorIndex = 6
        ws.Range(yVal(Target.Offset(, 2).Value) & xVal(Target.Offset(, 1).Value)).Resize(8, 4).Interior.Pattern = xlSolid
    Else
        ws.Range("K5:AD44").Interior.ColorIndex = xlNone
    End If
End If
End Sub

 

[Brew]

Thanks.....I copied and renamed the workbook, and removed and replaced the 3 codes and kept the 2 button programs within the code, however, neither button is activated. How do i reactivate them so i can the programs?

 

[dreid1011]

Thanks.....I copied and renamed the workbook, and removed and replaced the 3 codes and kept the 2 button programs within the code, however, neither button is activated. How do i reactivate them so i can the programs?

Not activated how? Can you click on the buttons without it selecting them?

 

[Brew]

when i click on the button, it just highlights to allow me to change the text, it doesnt execute or run the program