Add loop to this section of my Macro

hi there -

I currently have a functioning macro that has a section that finds "s.w." in the contents of a cell in one column (column A) and then pastes a certain formula into the corresponding cell in an adjacent column (column E) . I want this particular part of my macro to loop through till the last row with data in column A or until there are no more "S.W" cell contents.

This is what I want to loop:

Dim r As Range
    Set r = ActiveSheet.Range("A11:A500").Find(What:="*S.W.*", LookAt:=xlPart)
    If Not r Is Nothing Then r.Offset(, 4).Formula = "=GL(R7C9,R3C9,RC[-2],R4C9)"

The full macro looks like this:

Sub Portfolio2GL()
'DELETE SW
Dim x As Integer
     
    With Columns("C:C")
        .Replace What:="sw", Replacement:=""
    End With

'ADD ZERO
'Declarations

Dim cl As Range
Dim I As Long, endrow As Long

Application.ScreenUpdating = False
    'Converts the C column format to Text format
    Columns("C:C").NumberFormat = "@"
    'finds the bottom most row
    endrow = ActiveSheet.Range("C500").End(xlUp).Row
    '## Or, for Excel 2003 and prior: ##'
    'endrow = ActiveSheet.Range("C___").End(xlUp).Row

    'loop to move from cell to cell
    For I = 11 To endrow - 1
        Set cl = Range("C" & I)
        With cl
        'The Do-While loop keeps adding zeroes to the front of the cell value until it hits a length of 3
            Do While Len(.Value) < 3
                .Value = "0" & .Value
            Loop
        End With
    Next I
Application.ScreenUpdating = True

'ADD MAIN FORMULA 

Dim lastRow As Long
   lastRow = Range("D500").End(xlUp).Row - 1
   Range("E11").FormulaR1C1 = "=GL(R6C9,R3C9,RC[-2],R4C9)+GL(R5C9,R3C9,RC[-2],R4C9)"
   Range("E11").AutoFill Destination:=Range("E11:E" & Cells(Rows.Count, 2).End(xlUp).Row)

' REPLACE MAIN FORMULA with S.W. formula where necessary

Dim r As Range

    Set r = ActiveSheet.Range("A11:A500").Find(What:="*S.W.*", LookAt:=xlPart)
    If Not r Is Nothing Then r.Offset(, 4).Formula = "=GL(R7C9,R3C9,RC[-2],R4C9)"

End Sub

THANKS!

are you looking for this?

dim myCel as Range
Dim lr As Long
for each myCel in range("A11:A" & lr)
     if mycel.value="S.W." then
               mycel.Offset(, 4).Formula = "=GL(R7C9,R3C9,RC[-2],R4C9)"
next myCel

or this

Dim myCel As Range
Dim r As Range
Dim lr As Long
    lr = Cells(Rows.Count, 1).End(xlUp).Row
For Each myCel In Range("a1:a" & lr)
     Set r = myCel.Find(What:="*S.W.*", LookAt:=xlPart)
      If Not r Is Nothing Then myCel.Offset(, 4).Formula = "=GL(R7C9,R3C9,RC[-2],R4C9)"
Next myCel

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(I have added them for you today. Please read all the forum rules and comply in the future.)

glad it helpful, thank you for the feedback.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.