VBA for String search and Calling Sub just for that adjacent cell

Question

I want to create a logical range based on the location of where the program finds the string.

What I am attempting:

This sample workbook will have a column of dates and a column of statuses per sheet. Each sheet will also have another column to the right of the "status" column that simply outputs the word "Current" for that date. (If this is redundant and you would rather search for the current date in that first column that shows all the dates, feel free to ignore this. I only put it in to make it simple for me.)

This program needs to search in the column to the right of the status column for the string "current" and copy and paste that "status" cells value adjacent to it (or just locate the address via the rows date and run the sub for that specific row's "Status" cell if you wanted to ignore the "current" string thing). The Sample will not have the actual formulas in the status cells and only the values I put in for reference but it is the same principle.

Sub Ruby()
If Sheets("ALPHA").Range("T2:T5000").Value = "Current" Then
    Sheets("ALPHA").Select
    Call copy
End If
If Sheets("BRAVO").Range("T2:T5000").Value = "Current" Then
    Sheets("BRAVO").Select
    Call copy
End If
If Sheets("CHARLIE").Range("T2:T5000").Value = "Current" Then
    Sheets("CHARLIE").Select
    Call copy
End If
End Sub

Sub copy()
'
' copy Macro
'

'
Range("S98").Select
Selection.copy
Range("S98").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

Davesexcel Davesexcel · Accepted Answer · 2016-01-29T17:58:13

From what your code looks like, you want to change the formula in Column S to a value.

You can loop through each sheet and make it happen

Sub RubyLoop()
    Dim sh As Worksheet, LstRw As Long
    Dim rng As Range, c As Range

    For Each sh In Sheets
        With sh
            LstRw = .Cells(.Rows.Count, "T").End(xlUp).Row
            Set rng = .Range("T2:T" & LstRw)

            For Each c In rng.Cells
                If c = "Current" Then c.Offset(, -1).Value = c.Offset(, -1).Value
            Next c
        End With
    Next sh


End Sub

With end if

Sub RubyLoop2()
    Dim sh As Worksheet, LstRw As Long
    Dim rng As Range, c As Range

    For Each sh In Sheets
        With sh
            LstRw = .Cells(.Rows.Count, "T").End(xlUp).Row
            Set rng = .Range("T2:T" & LstRw)

            For Each c In rng.Cells
                If c = "Current" Then
                    c.Offset(, -1).Value = c.Offset(, -1).Value
                End If
            Next c
        End With
    Next sh


End Sub

VBA for String search and Calling Sub just for that adjacent cell

1 Answers

With end if