Offset Range Selection of all Cells Containing the Specified Value

norts55

Board Regular
Joined
Jul 27, 2012
Messages
183
Hello,
I found this code doing a google search that does almost what I want but I need to add a step. This macro with let you specify a value and create an Excel range selection of all cells containing the specified value. The extra step I need is an offset select from of all the selected cells. I am searching and finding the value "Note:". I can get this to work if there is only one cell found with "Note:" but I mostly have multiple cells with "Note:" and need the offset at all those locations.

Any help would be much appreciated. Thank you in advance.


VBA Code:
Sub Offset_From_Note()
'
' Offset_From_Note Macro
'

'
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
  fnd = "Note:"

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
    
    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell)
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Select Cells Containing Find Value
  rng.Select
 
    Range(ActiveCell.Offset(-1, -7), ActiveCell.Offset(-1, 1)).Select

Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"


End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Will the value you are searching for only occur in 1 column?
 
Upvote 0
In that case which cells are you after?
The code is trying to select cells 7 columns to the left, which it can't do if you're in col E.
 
Upvote 0
Sorry, I didn't update that prior to my post. Below is the offset.

Range(ActiveCell.Offset(4, 0), ActiveCell.Offset(6, 10)).Select
 
Upvote 0
Ok, how about
VBA Code:
Sub Offset_From_Note()
'
' Offset_From_Note Macro
'

'
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
  fnd = " and "

Set myRange = ActiveSheet.UsedRange.Columns(5)
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell.Offset(4).Resize(3, 10)

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
    
    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell.Offset(4).Resize(3, 10))
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop

'Select Cells Containing Find Value
  rng.Select
 
'    Range(ActiveCell.Offset(-1, -4), ActiveCell.Offset(-1, 1)).Select

Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"


End Sub
 
Upvote 0
Thank You! This works. I had to change the offsets to what I show below but it really works. Thank you again!

Set rng = FoundCell.Offset(4).Resize(2, 11)

Set rng = Union(rng, FoundCell.Offset(4).Resize(2, 11))
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top