0

Code :

Option Explicit

Sub selectAdjacentBelowCells()
Dim r, c As Integer
Dim r1, r2, c1, c2 As Integer
Dim i As Integer
Dim j As Integer
Dim st As String
Dim lastRow As Integer

With ActiveCell
    r = .Row
    c = .Column
End With
r1 = r
r2 = r

lastRow = ActiveSheet.Cells(Rows.Count, c).End(xlUp).Row

Dim value As Integer
value = Cells(r, c).value

Dim value1 As Integer
Dim value2 As Integer
Dim myUnion As Range
Dim myCell As Range

For i = r1 To lastRow - 1
    'selects adjacent cells below
    value1 = Cells(i + 1, c).value
    If (value1 = value) Then
        Range(Cells(i, c), Cells(i + 1, c)).Select
    Else
        Exit For
    End If
Next

Dim x As Integer
x = Cells(r2 - 1, c).value

For x = r2 To (r2 + 1) - r2 Step -1
    'selects adjacent cells above
    value2 = Cells(x - 1, c).value
    If (value2 = value) Then
        Range(Cells(r, c), Cells(x - 1, c)).Select
    Else
        Exit For
    End If
Next
End Sub

Column in excel :
10
20
30
40
50
60
60(this cell is selected and then vba code is executed)
60
70
80
90

I need to select adjacent cells in entire column. It selects adjacent cells, but first it selects adjacent cells below and then above. But the selection changes to above cells and below cells are deselected after the first piece of code runs.
I know it can be done through Union, I tried using it but I got errors everytime. Got argument is not optional error and then I had to remove the Union code and the above code is what I now have.

Aman Devrath
  • 398
  • 1
  • 3
  • 21
  • You might find [this](https://stackoverflow.com/q/10714251/445425) interesting – chris neilsen Jun 25 '18 at 04:47
  • So as per your description, do you want to select three cells with `60` as per the sample data and the selected cell? What if you replace first two values `10` and `20` with `60` in the sample data? Then which cells would you like to select in that case considering that your sample data is in the range `A1:A11`? – Subodh Tiwari sktneer Jun 25 '18 at 05:06
  • @chrisneilsen Thankyou for the link. I did find it useful. I'll use it for future references. – Aman Devrath Jun 25 '18 at 05:07
  • @sktneer only the adjacent cells in the column. the three `60`s should be selected. If value changes it stops. the final selection should be the three 60. If 60 is somewhere in the top or bottom with some other values between them, it wont be selected. only adjacent values(if same) will be selected – Aman Devrath Jun 25 '18 at 05:08
  • You mean only adjacent to the active cell should be selected if they all have same values. Right? – Subodh Tiwari sktneer Jun 25 '18 at 05:09
  • @sktneer yeah. the selected cell, and adjacent cells above and below(if same). – Aman Devrath Jun 25 '18 at 05:14
  • Okay. Check the answer I have posted. – Subodh Tiwari sktneer Jun 25 '18 at 05:15

1 Answers1

1

Please give this a try to see if that works for you.

Sub selectAdjacentBelowCells()
Dim targetCell As Range, Rng As Range, cell As Range, LastCell As Range, uRng As Range
Dim lr As Long
Dim firstAddress As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set targetCell = ActiveCell
Set LastCell = Range("A:A").SpecialCells(xlCellTypeLastCell)

With Range("A1:A" & lr)
    Set cell = .Find(what:=targetCell.value, after:=LastCell, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        firstAddress = cell.Address
        Do
            If uRng Is Nothing Then
                Set uRng = cell
            Else
                Set uRng = Union(uRng, cell)
            End If
            Set cell = .FindNext(cell)
        Loop While Not cell Is Nothing And cell.Address <> firstAddress
    End If
End With

For Each Rng In uRng.Areas
    If Not Intersect(Rng, targetCell) Is Nothing Then
        Rng.Select
        Exit For
    End If
Next Rng
End Sub
Subodh Tiwari sktneer
  • 9,906
  • 2
  • 18
  • 22