Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
find adjoing cells
You're welcome.
Ken Johnson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need Cells.find to find first number in a row which is 8000 | Excel Discussion (Misc queries) | |||
how to find cells that refer to data in other cells in excel | Excel Discussion (Misc queries) | |||
from a group of cells.find average of cells containing values | Excel Discussion (Misc queries) | |||
How to find multiple cells/replace whole cells w/data | Excel Discussion (Misc queries) | |||
If Cells.Find can't find anything | Excel Programming |