I have in the data base two adjoining horizontal cells having entries <x>
and <y>. respectively. How to find that row.
I have in the data base two adjoining horizontal cells having entries <x>
and <y>. respectively. How to find that row.
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
thanks a lot.
"Ken Johnson" <[email protected]> wrote in message
news:[email protected]...
> 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
>
You're welcome.
Ken Johnson
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks