Loop van find functie excel macro beëindigen

[stefke8447]

Ik heb voor excel 2010 een macro geschreven om de waarde "np" in een cel op te zoeken door middel van de find functie.
De functie zoekt de cel met "np" als inhoud, daarna wordt de inhoud van de cel gewist en tevens de inhoud van de 3 opeenvolgende cellen rechts van de cel met "np". In de daarop volgende cel wordt de opmerking "no participation" getypt.
Omdat ik alle cellen in het actieve werkblad wil vervangen, heb ik voor deze functie een do ... loop gemaakt.

Probleem is nu dat nadat alle cellen met "np" zijn gevonden en bewerkt, er een foutmelding komt. Hoe kan ik de do... loop functie beëidnigen nadat alle "np" zijn gevonden en vervangen?

De macro code is als volgt:

Range("A1").Select
Do
Cells.Find(What:="np", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Range("A1: D1").Select
Selection.ClearContents
ActiveCell.Offset(0, 3).Range("A1").Select
ActiveCell.FormulaR1C1 = "no participation"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop


Stefke

 

[mcs51mc]

Met onderstaande code loop ik éénmalig door alle cellen met een inhoud gelijk aan wat in variabel "strHeader" staat.
Dit is geen 1 op 1 oplossing voor jouw toepassing maar de methodiek zou bruikbaar moeten zijn:
1) Een Find starten
2) Check indien dergelijke cel gevonden is met de "If" functie
3) Indien gevonden: loop éénmalig door alle cellen met de "Do ... ... ... Loop While"

        strHeader = ReadINI(Variables.SettingsFile, keyGeneral, "hdrAddCol")
        Set objCell = objMySheet.Range("A2:GG2").Find(What:=strHeader, _
                                                      After:=objMySheet.Range("A2"), _
                                                      LookIn:=xlValues, _
                                                      LookAt:=xlWhole, _
                                                      SearchOrder:=xlByColumns, _
                                                      SearchDirection:=xlNext, _
                                                      MatchCase:=True, _
                                                      SearchFormat:=False)
                                                      
        If Not objCell Is Nothing Then
            'Gevonden: door alle cellen lopen en rechts van de kolom één kolom toevoegen
            strFirstAddress = objCell.Address
            Do
                objMySheet.Columns(objCell.Column + 1).Insert Shift:=xlToRight
                objCell.Offset(0, 1).Value = ReadINI(Variables.SettingsFile, keyGeneral, "hdrNormalized")
                
                Set objCell = objMySheet.Range("A2:GG2").FindNext(objCell)
            Loop While Not objCell Is Nothing And objCell.Address <> strFirstAddress
        End If

Hopelijk heb je hier iets aan... ... ...