find adjoing cells
 

I have in the data base two adjoining horizontal cells having entries <x
and <y. respectively. How to find that row.

find adjoing cells
 

Hi,
This macro might meet your needs. It searches the used range on the
worksheet for other cell ranges that are the same as the cell range
that you input after running the macro. As an example, say you are
looking for two adjacent cells where 3 is in the left cell and 5 is in
the right cell, then choose two adjacent empty cells on your sheet,
type 3 in the left cell and 5 in the right cell, then select these two
cells and run the macro. An input box will appear asking you to select
the range of cells to look for. Since you have already selected those
cells just click OK. When the macro finds another pair of adjacent
cells with 3 and 5 a MsgBox will show the address of that range of
cells. After you click OK the macro will search the rest of the
worksheet for other cell ranges with 3 and 5.

Public Sub find_range()
Dim vaLookFor As Variant
Dim vaLookAt As Variant
Dim stLookForAddress As String
Dim iRowCounter1 As Long
Dim iRowCounter2 As Long
Dim iColumnCounter1 As Integer
Dim iColumnCounter2 As Integer
Dim stResult As String
Dim FoundCount As Long
stResult = "Looking"
stLookForAddress = Application.InputBox( _
prompt:="Select the range of cells to look for", _
Default:=Selection.Address, Type:=8).Address
vaLookFor = Range(stLookForAddress)
vaLookAt = ActiveSheet.UsedRange
'Move across one column
For iColumnCounter1 = 1 To UBound(vaLookAt, 2) _
- UBound(vaLookFor, 2) + 1
'Move down one row
For iRowCounter1 = 1 To UBound(vaLookAt, 1) _
- UBound(vaLookFor, 1) + 1
If iRowCounter1 = 1 Then Let stResult = "Looking"
'Check values in columns
For iColumnCounter2 = 1 To UBound(vaLookFor, 2)
'Check values in rows
For iRowCounter2 = 1 To UBound(vaLookFor, 1)
'Exit For Next loop checking rows as
'soon as row values not equal
If vaLookAt(iRowCounter1 + iRowCounter2 - 1, _
iColumnCounter1 + iColumnCounter2 - 1) _
< vaLookFor(iRowCounter2, iColumnCounter2) Then
Let stResult = "Not Equal"
Exit For
End If
Next iRowCounter2
'Exit For Next loop checking columns because an
'unequal cell has been found
'Change stResult to "Looking" so that next part
'of Used Area is checked
If stResult = "Not Equal" Then
Let stResult = "Looking"
Exit For
ElseIf iColumnCounter2 = UBound(vaLookFor, 2) Then
'All cells equal, now tell user the address
If Range(Cells(iRowCounter1, iColumnCounter1), _
Cells(iRowCounter1 + UBound(vaLookFor, 1) - 1, _
iColumnCounter1 + UBound(vaLookFor, 2) - 1)).Address _
< Selection.Address Then
FoundCount = FoundCount + 1
MsgBox Range(Cells(iRowCounter1, iColumnCounter1), _
Cells(iRowCounter1 + UBound(vaLookFor, 1) - 1, _
iColumnCounter1 + UBound(vaLookFor, 2) - 1)).Address
End If
End If
Next iColumnCounter2
Next iRowCounter1
Next iColumnCounter1
If FoundCount = 0 Then
MsgBox "No other range on this sheet has that set of values"
End If
End Sub

Ken Johnson

find adjoing cells
 

thanks a lot.


"Ken Johnson" wrote in message
ups.com...
Hi,
This macro might meet your needs. It searches the used range on the
worksheet for other cell ranges that are the same as the cell range
that you input after running the macro. As an example, say you are
looking for two adjacent cells where 3 is in the left cell and 5 is in
the right cell, then choose two adjacent empty cells on your sheet,
type 3 in the left cell and 5 in the right cell, then select these two
cells and run the macro. An input box will appear asking you to select
the range of cells to look for. Since you have already selected those
cells just click OK. When the macro finds another pair of adjacent
cells with 3 and 5 a MsgBox will show the address of that range of
cells. After you click OK the macro will search the rest of the
worksheet for other cell ranges with 3 and 5.

Public Sub find_range()
Dim vaLookFor As Variant
Dim vaLookAt As Variant
Dim stLookForAddress As String
Dim iRowCounter1 As Long
Dim iRowCounter2 As Long
Dim iColumnCounter1 As Integer
Dim iColumnCounter2 As Integer
Dim stResult As String
Dim FoundCount As Long
stResult = "Looking"
stLookForAddress = Application.InputBox( _
prompt:="Select the range of cells to look for", _
Default:=Selection.Address, Type:=8).Address
vaLookFor = Range(stLookForAddress)
vaLookAt = ActiveSheet.UsedRange
'Move across one column
For iColumnCounter1 = 1 To UBound(vaLookAt, 2) _
- UBound(vaLookFor, 2) + 1
'Move down one row
For iRowCounter1 = 1 To UBound(vaLookAt, 1) _
- UBound(vaLookFor, 1) + 1
If iRowCounter1 = 1 Then Let stResult = "Looking"
'Check values in columns
For iColumnCounter2 = 1 To UBound(vaLookFor, 2)
'Check values in rows
For iRowCounter2 = 1 To UBound(vaLookFor, 1)
'Exit For Next loop checking rows as
'soon as row values not equal
If vaLookAt(iRowCounter1 + iRowCounter2 - 1, _
iColumnCounter1 + iColumnCounter2 - 1) _
< vaLookFor(iRowCounter2, iColumnCounter2) Then
Let stResult = "Not Equal"
Exit For
End If
Next iRowCounter2
'Exit For Next loop checking columns because an
'unequal cell has been found
'Change stResult to "Looking" so that next part
'of Used Area is checked
If stResult = "Not Equal" Then
Let stResult = "Looking"
Exit For
ElseIf iColumnCounter2 = UBound(vaLookFor, 2) Then
'All cells equal, now tell user the address
If Range(Cells(iRowCounter1, iColumnCounter1), _
Cells(iRowCounter1 + UBound(vaLookFor, 1) - 1, _
iColumnCounter1 + UBound(vaLookFor, 2) - 1)).Address _
< Selection.Address Then
FoundCount = FoundCount + 1
MsgBox Range(Cells(iRowCounter1, iColumnCounter1), _
Cells(iRowCounter1 + UBound(vaLookFor, 1) - 1, _
iColumnCounter1 + UBound(vaLookFor, 2) - 1)).Address
End If
End If
Next iColumnCounter2
Next iRowCounter1
Next iColumnCounter1
If FoundCount = 0 Then
MsgBox "No other range on this sheet has that set of values"
End If
End Sub

Ken Johnson

find adjoing cells
 

You're welcome.
Ken Johnson