Write to next 3 cells based on condition VBA while leaving formulas intact

0
votes

So I am trying to write a vba macro that can write the word "lunch" to the next 3 cells if the previous cell has the word "lunch" Lunch is populated in the cell by means of an if statement. I would like to have some vba code to read through each cell in the line, and if it finds the word lunch. the next 3 cells will now contain the word lunch. I would like to retain the formulas in the cells so that the functionality of the spreadsheet remains in tact. this is what I have written so far. but it is not working as desired. please help

Public Sub WriteLunchToCell()
Dim rg As Range
For Each rg In Sheet1.Range("BY62:FP62")
    If InStr(1, rg.Value, "Lunch", vbTextCompare) Then
        rg.Offset(, 1) = "Lunch"
        rg.Offset(, 2) = "Lunch"
        rg.Offset(, 3) = "Lunch"


End If
Next

End Sub

3
vbaexcel

3 Answers

0
votes

try something like this:

Set Rng = Range("a1:a6")

For Each cel In Rng
    If InStr(UCase(cel.Value), "LUNCH") <> 0 Then
        cel.Offset(0, 1).Value = "Lunch"
        cel.Offset(0, 2).Value = "Lunch"
        cel.Offset(0, 3).Value = "Lunch"
    End If
Next cel
0
votes

You would need to change the format of the cell rather than the value if you want the formulas to remain.

rg.Offset(, 1).NumberFormat = "General ""LUNCH"""
0
votes

You can nest another loop:

For i = 1 To 300
    Set MyRange = Sheet1.Range("BY" & 61 + i & ":FP" & 61 + i)

    For Each rg In MyRange

        If InStr(1, rg.Value, "Lunch", vbTextCompare) Then
            rg.Offset(, 1) = "Lunch"
            rg.Offset(, 2) = "Lunch"
            rg.Offset(, 3) = "Lunch"


    End If
    Next rg

Next i