change macro error

[rjplante]

I have a table listed below and I want to be able to write over the text in any cell in column A and have it highlight that column yellow. I then need to go down each column with the word "YES" in row 2 and highlight that column and row yellow. I have a macro that does this already, but when it runs, it will highlight the cells correctly and then throw a Run-Time error '1004': Method 'Range' of object '_worksheet' failed. If I select either the End or the Debug button Excel crashes, so I don't know exactly which line of the code is causing the workbook to crash. I would like to set this change macro up so that the user can either edit the text in column A, or just the price in any of the columns C, E, G, I, K, M, and O (overwriting the formulas listed there) and have those cells highlighted yellow indicating a change was made to those individual columns.

1) What in the macro is causing the workbook to crash?
2) How to I achieve the highlight for changes to cells in columns A, C, E, G, I, K, M, and O

Maybe I could just get rid of the is error and just note the fact that the indicated columns had a change and then execute the macro.

I am running office 365 on a windows 10 professional machine (64 bit)

Worksheet code window - Change macro

Private Sub Worksheet_Change(ByVal Target As Range)

'   Color custom row and delete lookup formula
Dim MyRow As Long

MyRow = Target.Row


Target.Offset(0, 2).Calculate

'   Check to see if there is an "#N/A" error in column C for the active row
If IsError(Range("C" & MyRow)) Then
    ActiveSheet.Unprotect Password:="dmt"

'   Highlight the current row cells in column A and C yellow.
    Range("A" & MyRow).Interior.Color = RGB(255, 255, 0)
    If Range("D4").Value = "YES" Then
        Range("C" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("F4").Value = "YES" Then
        Range("E" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("H4").Value = "YES" Then
        Range("G" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("J4").Value = "YES" Then
        Range("I" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("L4").Value = "YES" Then
        Range("K" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("N4").Value = "YES" Then
        Range("M" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If
    If Range("P4").Value = "YES" Then
        Range("O" & MyRow).Interior.Color = RGB(255, 255, 0)
    End If

'   Clear out column Q text
    Range("Q" & MyRow).ClearContents

'   Expand row height to fit
    Rows(ActiveCell.Row).AutoFit
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingRows:=True, AllowFiltering:=True, Password:="dmt"
End If

End Sub

Table:

		5' long	SubTotal	8' long	SubTotal	10' long	SubTotal	12' long	SubTotal	15' long	SubTotal	18' long	SubTotal	custom	SubTotal
	Quantity	2	YES	3		4	YES	5		6		7		8
Item	3
box 1	2	$25	$50	$35	$70	$45	$90	$55	$110	$65	$130	$75	$150	$85	$170
box 3	1	$30	$30	$40	$40	$50	$50	$60	$60	$70	$70	$80	$80	$90	$90

Thanks for the help,

Robert

 

[mart37]

When you change a cell through a Worksheet_Change then the Worksheet_Change is triggered again. So you create a loop.
With APPLICATION.ENABLEEVENTS you can prevent this.
I have the actions reduced to some lines.
The change-event responds on each change. In practise you will do that by some actions. Example: only when the cells C4:P100 are changed
With INTERSECT you can test of those cells are changed. On this site you can find examples.

Private Sub Worksheet_Change(ByVal Target As Range)
    '   Color custom row and delete lookup formula
    Dim MyRow As Long
    Dim col As Variant
   
    Application.EnableEvents = False
    MyRow = Target.Row
    Target.Offset(0, 2).Calculate
   
    '   Check to see if there is an "#N/A" error in column C for the active row
    If IsError(Range("C" & MyRow)) Then
        ActiveSheet.Unprotect Password:="dmt"
   
    '   Highlight the current row cells in column A and C yellow.
        Range("A" & MyRow).Interior.Color = RGB(255, 255, 0)
        For Each col In Array(4, 6, 8, 10, 12, 14, 16) 'columnnumbers for the columns with YES
            If UCase(Cells(4, col)) = "YES" Then Cells(MyRow, col - 1).Interior.Color = RGB(255, 255, 0)
        Next
   
    '   Clear out column Q text
        Range("Q" & MyRow).ClearContents
   
    '   Expand row height to fit
        Rows(ActiveCell.Row).AutoFit
       
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingRows:=True, AllowFiltering:=True, Password:="dmt"
    End If
    Application.EnableEvents = True
End Sub

 

[rjplante]

Thanks for the fix. I appreciate the clean up of the macro in general. This macro now works when cells in column A is changed, but if any of the cells in columns 4, 6, 8, 10, 12, 14, and 16 are changed without any change to cells in Column A, no highlight of the changed cell is initiated. In the last line of your description, you mentioned the INTERSECT function/tool, is that what I should use to track the changes in those other columns? If so, I will do some more research to find the fix I need for the indicated columns.

 

[mart37]

If IsError(Range("C" & MyRow)) Then
When Column C gives an error then the row highlighted. When column C gives no error then the row shall not highlighted.

 

[rjplante]

So how can I fix the code so that when column C does not give an error, but another cell is changed, that cell is highlighted? I have tried adding an else statement as follows:

Else
     Dim myCol As Long
     myCol = Target.Column
     Application.Intersect(myRow, myCol).Interior.Color = RGB(255, 255, 0)
End if

This does nothing when one of the other columns is changed.

 

[mart37]

        Cells(MyRow, myCol).Interior.Color = RGB(255, 255, 0)

 

[mart37]

You use intersect when you want to check two ranges. When you want only that the range A4:Q50 can change then you check of the target is in that range with:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, ActiveSheet.Range("A4:Q50") Is Nothing Then
        MsgBox "outside range"
    Else
        MsgBox "inside range"
    End If
End Sub

 

[rjplante]

Thanks for the clarification. I now have a problem in that the original macro will not run and nothing gets highlighted. I have saved the workbook, closed, and then reopened the book, and still no luck. It is still a macro enabled workbook as other macros are still working. Do you have any suggestions as to what I can do to fix this little issue?

 

[mart37]

In View Direct: Application.EnableEvents = True
or
In the first line place a break point (F9) With F8 you can step through the code.