简体   繁体   中英

Cell Referencing issue: Method 'Range' of Object ' _Worksheet fail on many intersected ranges

I am receiving a

Method 'Range' of object '_Worksheet failure

for the following code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim rngF As Range
    Dim rngC As Range
    Dim aCell As Range
    Dim bCell As Range
    Dim wkSheet1 As Worksheet

    'recursive error prevention
    On Error GoTo Whoa
    Application.EnableEvents = False

    '~~> Set your range
    Set wkSheet1 = ThisWorkbook.Worksheets("backend")
    Set rngF = wkSheet1.Range(Cells("C5:C500,H5:H500,M5:M500,R5:R500,W5:W500,AB5:AB500,AG5:AG500,AL5:AL500,AQ5:AQ500,AV5:AV500,BA5:BA500,BF5:BF500,BK5:BK500,BP5:BP500,BU5:BU500,BZ5:BZ500,CE5:CE500,CO5:CO500,CT5:500,CY5:CY500,DD5:DD500,DI5:DI500,DN5:DN500,DS5:DS500,DX5:DX500,EC5:EC500").Address)
    Set rngC = wkSheet1.Range(Cells("D5:D500,I5:I500,N5:N500,S5:S500,X5:X500,AC5:AC500,AH5:AH500,AM5:AM500,AR5:AR500,AW5:AW500,BB5:BB500,BG5:BG500,BL5:BL500,BQ5:BQ500,BV5:BV500,CA5:CA500,CF5:CF500,CP5:CP500,CU5:500,CZ5:CZ500,DE5:DE500,DJ5:DJ500,DO5:DO500,DT5:DT500,DY5:DY500,ED5:ED500").Address)

'fORECAST
If Not Application.Intersect(Target, rngF) Is Nothing Then

        For Each aCell In rngF
            If aCell.Value <> "" Then
                If aCell.Value <> "N/A,TBC,TBA,TBD" Then
                    If aCell.Value < Date Then
                        aCell.ClearContents
                        MsgBox "PAST date not allowed in cell " & aCell.Address

                    Else

                    End If
                End If
            End If
        Next
    End If

  'complete
  If Not Application.Intersect(Target, rngC) Is Nothing Then

        For Each bCell In rngC
            If bCell.Value <> "" Then

                    If bCell.Value > Date Then
                        bCell.ClearContents
                        MsgBox "Future date not allowed in cell " & bCell.Address

                    Else

                    End If

            End If
        Next
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

This code has been adapted from an answer that a user: Siddharth Rout originally answered, found here: ORIGINAL CODE .

Now, I have changed the number of If functions to 2 subsets.

The first checks that dates are not in the past and ignores "N/A, TBC,etc", while the second does exactly the same but for dates in the future. Now, this code works absolutely beautifully when you apply each IF subset to a single range for each: like A5:500 and B5:500. (On a new sheet for example) BUT, I need to apply these rules to work over the ranges specified above. This code is in the 'backend' worksheet of my project, where the ranges to be checked are. I don't know if it makes a difference, but the data that arrives in the backend sheet is generated by a different macro that is coded in the frontend part of the workbook. This macro generates 3 data changes and I receive the error message 3 times, which is good because it tells me that the first macro is inserting as it should and the backend macro recognizes the changes, just obviously is getting stuck on the reference somewhere. Any advice would be greatly appreciated!

It seems that you are over-wrapping the range assignments. The Range.Cells Property does not take cell addresses as parameter(s) and you don't need to specify the worksheet in a Worksheet_Change event macro unless you are referring to another worksheet.

Identifying the pattern in your non-contiguous range(s) may make it easier to set and avoid simple typos.

Dim c As Long, rngF As Range, rngA As Range
Set rngF = Range("C5:C500")
For c = 5 To 133 Step 5
    Set rngF = Union(rngF, rngF.Offset(0, 5))
Next c
Set rngA = rngF.Offset(0, 1)

In all actuality, I probably wouldn't even declare/assign anything to rngA . Anytime it needs to be referenced, you could simply use rngF.Offset(0, 1) .

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM