Worksheet_Selection Change

[samuel.nunn]

I am fairly new to VBA and I'm trying to create an event-handler macro that will:

1) Only apply to cells C7:C65536 (not all the cells in the worksheet)
2) If any value appears in those cells in Column C, it will reference the next column to the right: Column D, which already has number values usually ranging from 1-10 and perform a loop to shade those cells (in Column D) in purple WHILE value in column D is GREATER than the cell we STARTED on.

Private Sub Worksheet_SelectionChange(<wbr>ByVal Target As Range)
    Range("C7:C65536").Select
        Range(ActiveCell.Offset(0, 1)).Select

        Do While ActiveCell.Offset(1, 0) > ActiveCell.Value
            ActiveCell.FormatConditions(1)<wbr>.Interior.ColorIndex = 39
            ActiveCell.Offset(1, 0).Select
        Loop

End Sub

Thanks!
Sam

 

[Kenneth Hobson]

Welcome to the forum!

Can you give some data to show what you want in more detail?

 

[stanleydgromjr]

samuel.nunn,

Welcome to the MrExcel board.

If I understand you correctly, try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Right click the sheet tab you want the code in, and click on View Code. Paste the below code there (on the right pane).

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("C7:C65536")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim Ctr As Long
    For Ctr = Target.Row To 65536 Step 1
        If Range("D" & Ctr).Value > Range("C" & Ctr).Value Then
            Range("D" & Ctr).Interior.ColorIndex = 39
        End If
    Next Ctr
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Have a great day.
Stan

 

[samuel.nunn]

samuel.nunn,

Welcome to the MrExcel board.

If I understand you correctly, try:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Right click the sheet tab you want the code in, and click on View Code. Paste the below code there (on the right pane).

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("C7:C65536")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim Ctr As Long
    For Ctr = Target.Row To 65536 Step 1
        If Range("D" & Ctr).Value > Range("C" & Ctr).Value Then
            Range("D" & Ctr).Interior.ColorIndex = 39
        End If
    Next Ctr
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Have a great day.
Stan

Kenneth and Stan,

Thanks for your help. I think we're on the right track.

Four things:
1) The macro isn't running until you click off the cell, and then click back on the cell.
2) It doesn't shade the cell directly to the right.
3) When shading, it shades all the way down to the bottom of the range... it doesn't stop when it hits a "Tier" less than the starting "Tier" (in Column D). In the photo below, choosing "Move" in column C should prompt Column D to shade Tiers 4, 5, and 6 (it should not shade Tier 3 since it is less than the starting Tier: Tier 4).
4) Is there a way to toggle this feature? In other words, if I remove the text from column C, can the appropriate shading in column D go away?

Thanks!
Sam

 

[stanleydgromjr]

samuel.nunn,

Please post a screenshot of your sheet(s), what you have and what you expect to achieve, with Excel Jeanie HTML 4.
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php


Have a great day,
Stan

 

[RoryA]

If you want the code to run when you change the value of a cell, you want the Worksheet_Change event, not the SelectionChange event.

 

[Kenneth Hobson]

If you do quote text or code, please just post snippets since we know what was posted before.

The Jeanie clip helped.

Right click your sheet tab, View Code, and paste:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, iRow As Long, dVal As Double
  Dim rD As Range, rDVal As Double, lastDRow As Long
  Set r = Intersect(Target, Range("C7:C" & Rows.Count))
  If r Is Nothing Or Target.Count > 1 Then Exit Sub
  
  On Error GoTo EndNow
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  lastDRow = Range("D" & Rows.Count).End(xlUp).Row
  iRow = 0
  Set rD = Target.Offset(iRow, 1)
  rD.Interior.ColorIndex = 39 'Set first D's colorindex
  rDVal = rD.Value
  
  If Target.Value = "" Then
    rD.Offset(iRow).Interior.ColorIndex = xlColorIndexNone
    Do Until rD.Offset(iRow, -1).Value <> "" Or rD.Offset(iRow).Row > lastDRow
      rD.Offset(iRow + 1).Interior.ColorIndex = xlColorIndexNone
      iRow = iRow + 1
    Loop
    Else
      Do Until rD.Offset(iRow + 1).Value <= rDVal Or rD.Offset(iRow + 1, -1).Value <> ""
        rD.Offset(iRow + 1).Interior.ColorIndex = 39
        iRow = iRow + 1
      Loop
      Do Until rD.Offset(iRow, -1).Value = "" Or rD.Offset(iRow).Row > lastDRow
        rD.Offset(iRow + 1).Interior.ColorIndex = xlColorIndexNone
        iRow = iRow + 1
      Loop
  End If
  
EndNow:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

 

[samuel.nunn]

Thanks! That worked perfectly! What VBA books do you recommend? How did you learn?

 

[Kenneth Hobson]

1. Excel 2003 Power Programming by John Walkenbach. His site and other mvp's are found at: http://www.mvps.org/links.html#Excel
2. Practice. The more you help others, the more you learn.

 

[samuel.nunn]

Kenneth,

I'm having a small problem with the code. When dealing with adjacent rows (specifically, changing the value above an already shaded cell), changing the value in column C, causes the next row down in column D to unshade (if it was shaded before).



For instance, if I changed cell C10 to "ZIP", D10 would shade purple, but D11 would UNshade.

Also, if D9:D11 were already shaded purple, and I cleared cell C10, D10 AND D11 would unshade.

These problems can be seen in cells D14:D17

What do you think?

Thanks!