A sub procedure that is able to check the value of a cell in the same row as the activecell from a Private Sub Worksheet_change

Question

I am relatively new to using Excel VBA. I created an analysis tool for an assessment in school so that the teachers workload could be reduced. The spreadsheet got far too large and due to the multiple scenarios needed and conditional formatting the spreadsheet became slow and problematic.

I have a Private Sub worksheet_change (ByVal Target As Range) as follows which works.

   Private Sub Worksheet_Change(ByVal Target As Range)  

   If (Cells(3, Target.Column) = "AUT" Or Cells(3, Target.Column) = "SPR" Or Cells(3, Target.Column) = "SUM") And Target.Column >= 1 And Target.Row >= 4 And Target.Row <= 500 Then

      If Cells(Target.Row, "M").Value = "MLD" And Cells(Target.Row, "ET").Value = 1 And Cells(Target.Row, Target.Column - 1) = 2 Then         
      Call Year1Start         
      End If      
    End If      
    End Sub

I've tried to create a Sub procedure but to no avail:

    Sub Year1Start()

       If Cells(Target.Row, "EM").Value = 0.4 Then

       Call Y1StartY2DataEntry040

    End If

    End Sub

    Sub Y1StartY2DataEntry040()

    'check the various outputs for year 1 start with year 2 data entry:
    'y1=0.4     R0.42,Y0.44,G0.46, B0.48

    ActiveCell.Offset(0, 1).Select

    If ActiveCell.Value < 0.44 Then
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "R"
    ActiveCell.Offset(0, -2).Select
    ActiveCell.Interior.Color = RGB(255, 0, 0)
    ActiveCell.Offset(0, 1).Select
    End If

    If ActiveCell.Value = 0.44 Then
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "Y"
    ActiveCell.Offset(0, -2).Select
    ActiveCell.Interior.Color = RGB(255, 255, 51)
    ActiveCell.Offset(0, 1).Select
    End If

    If ActiveCell.Value = 0.46 Then
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "G"
    ActiveCell.Offset(0, -2).Select
    ActiveCell.Interior.Color = RGB(51, 225, 51)
    ActiveCell.Offset(0, 1).Select
    End If

    If ActiveCell.Value >= 0.48 Then
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = "B"
    ActiveCell.Offset(0, -2).Select
    ActiveCell.Interior.Color = RGB(55, 142, 225)
    ActiveCell.Offset(0, 1).Select
    End If

    If ActiveCell.Value = isblank Then
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Interior.ColorIndex = 0
    ActiveCell.Offset(0, 2).Select
    ActiveCell.Value = ""
    ActiveCell.Offset(0, -2).Select
    End If

    End Sub

Basically I need to check to see if the value is true then it calls a new procedure.

I need to do it this way because I got procedure too large before.

First thing would be to stop using ActiveCell and Select...http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — Rdster, Nov 29 '16 at 19:20
What problems are you having? I can see that `Year1Start` won't like accessing the unknown variable `Target` (you probably need to pass it as a parameter), but is that the only issue? — YowE3K, Nov 29 '16 at 19:43

Scott Holtzman · Answer 1 · 2016-11-29T20:30:26.847

I had some down time and decided to refactor the code as you can definitely accomplish this in one procedure inside the Worksheet_Change utilizing some good indentation and different programming techniques.

Specifically notice my use of Select Case, multiple If blocks (for readability) and how I work directly with objects, instead of using ActiveCell and Select.

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Cells(3, Target.Column)

    Case Is = "AUT", "SPR", "SUM"

        If Target.Column >= 1 And Target.Row >= 4 And Target.Row <= 500 Then

            If Cells(Target.Row, "M").Value = "MLD" Then

                If Cells(Target.Row, "ET").Value = 1 And Cells(Target.Row, Target.Column - 1) = 2 Then

                    If Cells(Target.Row, "EM").Value = 0.4 Then

                        Dim sVal As String, r As Integer, g As Integer, b As Integer

                        Select Case Target.Offset(, 1).Value

                            Case Is < 0.44: sVal = "R": r = 255: g = 0: b = 0

                            Case Is = 0.44: sVal = "Y": r = 255: g = 255: b = 51

                            Case Is = 0.46: sVal = "G": r = 51: g = 225: b = 51

                            Case Is >= 0.48: sVal = "B": r = 55: g = 142: b = 225

                            Case Is = "": sVal = "":

                        End Select

                        Target.Offset(, 2).Value = sVal

                        If Len(Target.Offset(, 1)) = 0 Then
                            Target.Interior.ColorIndex = 0
                        Else
                            Target.Interior.Color = RGB(r, g, b)
                        End If

                    End If

                End If

            End If

        End If

End Select

End Sub

Note - A way to trim this code down would be to use a helper column in the spreadsheet as a flag column to test against in the code with the conditions in the 2nd, 3rd & 4th If blocks.

Now the only problem is what happens when `Target` has a value of 0.45 - but that's something for the OP to work out. — YowE3K, Nov 29 '16 at 20:32

A sub procedure that is able to check the value of a cell in the same row as the activecell from a Private Sub Worksheet_change

1 Answers1