VBA Macro To Find Specific Text And Insert Text Few Rows Below

[Flupsie]

I have a workbook with several sheets and want to find "DEPR-GENERATORS" in Col B and insert "DEPR in front on the text from one row below to 5 rows below

This must exclude sheets "Data", "Accounts", "TB"

The macro is only affecting the active sheet

When running the macro the text is inserted for eg DEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPR-COMPUTER EQUIP

See Sample data

Sub find_Dep()
 Dim Sh As Worksheet
    Dim lr As Long
   For Each Sh In ActiveWorkbook.Worksheets
       Select Case Sh.Name
            Case "Data", "Accounts", "TB"
            Case Else

       
            
            With Sh
                lr = .Cells(.Rows.Count, "B").End(xlUp).Row
             Cells.Find(What:="DEPR-GENERATORS", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
                '.Range("B1:B" & lr).Resize(5).Replace What:="   ", Replacement:="DEPR", LookAt:=xlPart
        For i = 1 To 5
            ActiveCell.Offset(i, 1) = "DEPR" & Trim(ActiveCell.Offset(i))
        Next
End With

 End Select
Next Sh

End Sub

Your assistance in correcting the code is much appreciated

[snb]

Sample Data ????

[Ingolf]

Cross post

http://www.mrexcel.com/forum/excel-q...ific-text.html

[Flupsie]

Have managed to sort out the code, but want to exit code after finding "DEPR" one row below DEPR-GENERATORS, the macro must stop, otherwise Insert "DEPR" in front of the text five rows below, but cannot get it to work

 Option Explicit
Sub Find_Depr ()




Dim i As Long, ii As Long, iii As Long
Dim MyArr As Variant
Dim c As Range

MyArr = Array("Br1", "Br2", "Br3") 'Your sheet names
              
Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

   With Sheets(MyArr(i))

        ' "DEPR-GENERATORS" will be in Column B1:Bn
        Set c = .Range("B:B").Find(What:="DEPR-GENERATORS", _
                After:=.Range("B1"), _
                LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext)
                      
        ' Put DEPR in front of the text in the next 5 rows below found Text "DEPR-GENERATORS"
       For iii = 1 To 1
       
        If c.Offset(iii) Like "Depr" Then
        Exit Sub
        
       End If
        Else
         For ii = 1 To 5
            c.Offset(ii) = "DEPR" & Trim(c.Offset(ii))
        Next ' ii
   End With

Next 'i
Application.ScreenUpdating = True
End Sub

see sample data below
https://www.dropbox.com/s/ekbr242gcr...nd%20Depr.xlsm

[snb]

I don't like crossposts, nor files on external servers (if they have been deleted there this whole thread wil fall into smithereens....)

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
http://www.eileenslounge.com/viewtopic.php?f=30&t=41784
http://www.eileenslounge.com/viewtopic.php?p=323966#p323966
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960
http://www.eileenslounge.com/viewtopic.php?p=323894#p323894
http://www.eileenslounge.com/viewtopic.php?p=323843#p323843
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6BSa173Z
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6-64Xpgl
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ms39yjd
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ZXJwRCM
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4Pr15NUt
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4I83JelY
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HABa3tnAjhZU
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HABa3KswxL3c
https://www.youtube.com/watch?v=suUqEo3QWus&lc=UgyBXFxnVWT3pqtdqPx4AaABAg
https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABZ8N9O-O8p
http://www.eileenslounge.com/viewtopic.php?p=323547#p323547
http://www.eileenslounge.com/viewtopic.php?p=323516#p323516
http://www.eileenslounge.com/viewtopic.php?p=323517#p323517
http://www.eileenslounge.com/viewtopic.php?p=323449#p323449
http://www.eileenslounge.com/viewtopic.php?p=323226#p323226
http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150
http://www.eileenslounge.com/viewtopic.php?p=323085#p323085
http://www.eileenslounge.com/viewtopic.php?p=322955#p322955
http://www.eileenslounge.com/viewtopic.php?f=30&t=41659
https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABZ8N9O-O8p
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgxREWxgx2z2Lza_0st4AaABAg
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgyikSWvlxbWS24NBeR4AaABAg
https://www.youtube.com/watch?v=C43btudYyzA&lc=UgwNiH4hhyrd2UjDK8d4AaABAg
https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HAAf952WoUti
https://www.youtube.com/watch?v=hz4vb48wzMM&lc=Ugy2N3gvXBNrvWpojqR4AaABAg
http://www.eileenslounge.com/viewtopic.php?p=322462#p322462
http://www.eileenslounge.com/viewtopic.php?p=322356#p322356
http://www.eileenslounge.com/viewtopic.php?p=321984#p321984
https://eileenslounge.com/viewtopic.php?f=30&t=41610
https://eileenslounge.com/viewtopic.php?p=322176#p322176
https://eileenslounge.com/viewtopic.php?p=322238#p322238
https://eileenslounge.com/viewtopic.php?p=322270#p322270
https://eileenslounge.com/viewtopic.php?p=322300#p322300
http://www.eileenslounge.com/viewtopic.php?p=322150#p322150
http://www.eileenslounge.com/viewtopic.php?p=322111#p322111
http://www.eileenslounge.com/viewtopic.php?p=322086#p322086
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[bakerman]

Flupsie,
Please read following link regarding you crossposting.
http://www.excelfox.com/forum/f25/me...1172/#post5326

Also, on the other forum you have marked your question as resolved.
Out of respect for all the helpers here who share their expertise free of charge you could have put a message here informing everyone that you have received a suitable answer to your question.

[Flupsie]

My apologies for not showing the link to the crosspost

Problem now resolved