Limit a vba script to a column or a cell range

Parfumdecuir

New Member
Joined
Aug 24, 2021
Messages
2
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello,

Below what I hope will be a very easy question to answer ?

I was able to find online a working script for my need (to search and select all cells that contain a specific text in worksheet)

VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim firstaddress As String

Application.ScreenUpdating = False
With ActiveSheet

    'find first cell that contains "ABCDEF"
    Set c = .Cells.Find(What:="ABCDEF", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
    xlPart, MatchCase:=False)
    
    'if the search returns a cell
    If Not c Is Nothing Then
        'note the address of first cell found
        firstaddress = c.Address
        Do
            'FoundCells is the variable that will refer to all of the
            'cells that are returned in the search
            If FoundCells Is Nothing Then
                Set FoundCells = c
            Else
                Set FoundCells = Union(c, FoundCells)
            End If
            'find the next instance of "ABCDEF"
            Set c = .Cells.FindNext(c)
        Loop While Not c Is Nothing And firstaddress <> c.Address
                
        'after entire sheet searched, select all found cells
        FoundCells.Select
    Else
        'if no cells were found in search, display msg
        MsgBox "No cells found."
    End If
End With
Application.ScreenUpdating = True

End Sub

I would simply like to limit it to a specific column or specific range of cells, and not the whole sheet. (Either by restrict the search range or the select range at the end)

In any case thanks for your time!
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
I would simply like to limit it to a specific column or specific range of cells, and not the whole sheet.
Try changing the first part of the code like this. The rest of the code would remain the same

VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim firstaddress As String

Const myRange As String = "G:H" 'Another example "B10:H16"

Application.ScreenUpdating = False
With ActiveSheet.Range(myRange)

    'find first cell that contains "ABCDEF"
    Set c = .Find(What:="ABCDEF", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
    
    'if the search returns a cell
    If Not c Is Nothing Then
 
Upvote 0
Solution
Try changing the first part of the code like this. The rest of the code would remain the same

VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim firstaddress As String

Const myRange As String = "G:H" 'Another example "B10:H16"

Application.ScreenUpdating = False
With ActiveSheet.Range(myRange)

    'find first cell that contains "ABCDEF"
    Set c = .Find(What:="ABCDEF", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
   
    'if the search returns a cell
    If Not c Is Nothing Then

Perfect !

Exactly what I needed.

Thanks a lot.
 
Upvote 0
You're welcome. Thanks for the follow-up. :)
 
Upvote 0
Try changing the first part of the code like this. The rest of the code would remain the same

VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim firstaddress As String

Const myRange As String = "G:H" 'Another example "B10:H16"

Application.ScreenUpdating = False
With ActiveSheet.Range(myRange)

    'find first cell that contains "ABCDEF"
    Set c = .Find(What:="ABCDEF", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
   
    'if the search returns a cell
    If Not c Is Nothing Then

I am trying to do the same thing. I have multiple lists and some of them I need to be able to select multiple options, while the other I need only one option.



Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2023/01/11
'Updated by Ken Gardner 2022/07/11
Dim xRng As Range
Dim xValue1 As String
Dim xValue2 As String
Dim semiColonCnt As Integer
Dim xType As Integer
If Target.Count > 1 Then Exit Sub
On Error Resume Next

xType = 0
xType = Target.Validation.Type
If xType = 3 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
xValue2 = Target.Value
Application.Undo
xValue1 = Target.Value
Target.Value = xValue2
If xValue1 <> "" Then
If xValue2 <> "" Then
If xValue1 = xValue2 Or xValue1 = xValue2 & ";" Or xValue1 = xValue2 & "; " Then ' leave the value if only one in list
xValue1 = Replace(xValue1, "; ", "")
xValue1 = Replace(xValue1, ";", "")
Target.Value = xValue1
ElseIf InStr(1, xValue1, "; " & xValue2) Then
xValue1 = Replace(xValue1, xValue2, "") ' removes existing value from the list on repeat selection
Target.Value = xValue1
ElseIf InStr(1, xValue1, xValue2 & ";") Then
xValue1 = Replace(xValue1, xValue2, "")
Target.Value = xValue1
Else
Target.Value = xValue1 & "; " & xValue2
End If
Target.Value = Replace(Target.Value, ";;", ";")
Target.Value = Replace(Target.Value, "; ;", ";")
If Target.Value <> "" Then
If Right(Target.Value, 2) = "; " Then
Target.Value = Left(Target.Value, Len(Target.Value) - 2)
End If
End If
If InStr(1, Target.Value, "; ") = 1 Then ' check for ; as first character and remove it
Target.Value = Replace(Target.Value, "; ", "", 1, 1)
End If
If InStr(1, Target.Value, ";") = 1 Then
Target.Value = Replace(Target.Value, ";", "", 1, 1)
End If
semiColonCnt = 0
For i = 1 To Len(Target.Value)
If InStr(i, Target.Value, ";") Then
semiColonCnt = semiColonCnt + 1
End If
Next i
If semiColonCnt = 1 Then ' remove ; if last character
Target.Value = Replace(Target.Value, "; ", "")
Target.Value = Replace(Target.Value, ";", "")
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub


What do you suggest me to do? I need the VBA script to be limited to the cells in the sheet that only require multiple options to be selected.
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

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