搜索具有特定文本的所有单元格的范围并将所有相邻单元格的值更改为 0

Question

Looking for help to achieve searching a range of cells E9:E with All cells containing "Accommodation & Transportation" and changing the value of the cells adjacent to them with 0. , I was not able to get anything online with similar topic and I'm not too good with VBA coding, though i am able to understand what the code will provide in results.

I Have a Commandbutton1 with the below code:

Sub CommandButton1_click()

Dim blanks As Excel.Range

Set blanks = Range("F9:F" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)

blanks.Value = blanks.Offset(0, -1).Value

End Sub

Further i have a command button that will select only cells that are not blank. I need the above result because if the below code selects Non Blank cells from Columns E:F it wont be selecting cells adjacent to those containing "Accommodation & Transportation" as they are blank cells and it will return the error "Runtime Error '1004' This action wont work on multiple selections".

The below code acts the same as [Go to Special => Constants]

Sub SelectNonBlankCells()

Dim rng As Range
Dim OutRng As Range
Dim InputRng As Range
Dim xTitle As String


On Error Resume Next

xTitle = Application.ActiveWindow.RangeSelection.Address

Set InputRng = Range("E8:F500")

ActiveWindow.ScrollRow = 1

For Each rng In InputRng

If Not rng.Value = "" Then

If OutRng Is Nothing Then

Set OutRng = rng

Else

Set OutRng = Application.Union(OutRng, rng)

End If

End If

Next

If Not (OutRng Is Nothing) Then

OutRng.Select

End If

End Sub

Answer 1

Maybe you can try another approach, if your goal is to edit cells adjacent to certain cells. The code below is based on an example in the Help file of the Range.Find function:

Sub DoSomething()

    Dim sh As Worksheet
    Set sh = ActiveSheet
    
    Dim checkRange As Range
    Set checkRange = sh.Range("E8:F500") ' your intended range to search
    
    Dim foundRange As Range
    Set foundRange = checkRange.Find("Accommodation & Transportation")
    
    Dim firstAddr As String
    
    If Not foundRange Is Nothing Then
    
        firstAddr = foundRange.Address
        Do
        
            ' use foundRange to access adjacent cells with foundRange.Offset(row, col)
            '
            '
            foundRange.Offset(0, 1) = "all good"
            
            Set foundRange = checkRange.FindNext(foundRange)
            
        Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
    End If

End Sub

Or even better, you could add some parameters to make it more reusable:

Sub Main()

    DoSomething "Accommodation & Transportation", ActiveSheet.Range("E8:F500")

End Sub


Sub DoSomething(ByVal findWhat As String, ByVal searchWhere As Range)

    Dim foundRange As Range
    Set foundRange = searchWhere.Find(findWhat)
    
    Dim firstAddr As String
    
    If Not foundRange Is Nothing Then
    
        firstAddr = foundRange.Address
        Do
        
            ' use foundRange to access adjacent cells with foundRange.Offset(row, col)
            '
            '
            foundRange.Offset(0, 1) = "all good"
            
            Set foundRange = searchWhere.FindNext(foundRange)
            
        Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
    End If

End Sub