+ Reply to Thread
Results 1 to 4 of 4

find adjoing cells

  1. #1
    R..VENKATARAMAN
    Guest

    find adjoing cells

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




  2. #2
    Ken Johnson
    Guest

    Re: 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


  3. #3
    R..VENKATARAMAN
    Guest

    Re: find adjoing cells

    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
    >




  4. #4
    Ken Johnson
    Guest

    Re: find adjoing cells

    You're welcome.
    Ken Johnson


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1