Vba excel проверить все ячейки в диапазоне

If the two ranges to be tested (your given cell and your given range) are not in the same Worksheet, then Application.Intersect throws an error. Thus, a way to avoid it is with something like

Sub test_inters(rng1 As Range, rng2 As Range)
    If (rng1.Parent.Name = rng2.Parent.Name) Then
        Dim ints As Range
        Set ints = Application.Intersect(rng1, rng2)
        If (Not (ints Is Nothing)) Then
            ' Do your job
        End If
    End If
End Sub

answered Jan 8, 2015 at 11:11

@mywolfe02 gives a static range code so his inRange works fine but if you want to add dynamic range then use this one with inRange function of him.this works better with when you want to populate data to fix starting cell and last column is also fixed.

Sub DynamicRange()

Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range

Set sht = Worksheets("xyz")
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Set rng = Workbooks("Record.xlsm").Worksheets("xyz").Range(Cells(12, 2), Cells(LastRow, 12))

Debug.Print LastRow

If InRange(ActiveCell, rng) Then
'        MsgBox "Active Cell In Range!"
  Else
      MsgBox "Please select the cell within the range!"
  End If

End Sub 

answered Dec 8, 2015 at 8:53

I don’t work with contiguous ranges all the time. My solution for non-contiguous ranges is as follows (includes some code from other answers here):

Sub test_inters()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim inters As Range

    Set rng2 = Worksheets("Gen2").Range("K7")
    Set rng1 = ExcludeCell(Worksheets("Gen2").Range("K6:K8"), rng2)

    If (rng2.Parent.name = rng1.Parent.name) Then
        Dim ints As Range
        MsgBox rng1.Address & vbCrLf _
        & rng2.Address & vbCrLf _

        For Each cell In rng1
            MsgBox cell.Address
            Set ints = Application.Intersect(cell, rng2)
            If (Not (ints Is Nothing)) Then
                MsgBox "Yes intersection"
            Else
                MsgBox "No intersection"
            End If
        Next cell
    End If
End Sub

answered May 29, 2018 at 20:20

If the two ranges to be tested (your given cell and your given range) are not in the same Worksheet, then Application.Intersect throws an error. Thus, a way to avoid it is with something like

Sub test_inters(rng1 As Range, rng2 As Range)
    If (rng1.Parent.Name = rng2.Parent.Name) Then
        Dim ints As Range
        Set ints = Application.Intersect(rng1, rng2)
        If (Not (ints Is Nothing)) Then
            ' Do your job
        End If
    End If
End Sub

answered Jan 8, 2015 at 11:11

@mywolfe02 gives a static range code so his inRange works fine but if you want to add dynamic range then use this one with inRange function of him.this works better with when you want to populate data to fix starting cell and last column is also fixed.

Sub DynamicRange()

Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range

Set sht = Worksheets("xyz")
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Set rng = Workbooks("Record.xlsm").Worksheets("xyz").Range(Cells(12, 2), Cells(LastRow, 12))

Debug.Print LastRow

If InRange(ActiveCell, rng) Then
'        MsgBox "Active Cell In Range!"
  Else
      MsgBox "Please select the cell within the range!"
  End If

End Sub 

answered Dec 8, 2015 at 8:53

I don’t work with contiguous ranges all the time. My solution for non-contiguous ranges is as follows (includes some code from other answers here):

Sub test_inters()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim inters As Range

    Set rng2 = Worksheets("Gen2").Range("K7")
    Set rng1 = ExcludeCell(Worksheets("Gen2").Range("K6:K8"), rng2)

    If (rng2.Parent.name = rng1.Parent.name) Then
        Dim ints As Range
        MsgBox rng1.Address & vbCrLf _
        & rng2.Address & vbCrLf _

        For Each cell In rng1
            MsgBox cell.Address
            Set ints = Application.Intersect(cell, rng2)
            If (Not (ints Is Nothing)) Then
                MsgBox "Yes intersection"
            Else
                MsgBox "No intersection"
            End If
        Next cell
    End If
End Sub

answered May 29, 2018 at 20:20