Weergeven verschillende tabladen tijdens uitvoeren macro

[Figaro75]

Wie o wie kan mij helpen?

Via een collega de vraag gekregen of er in Excel 2007 gezocht kan worden naar een bepaalde waarde waarna de volledige rij wordt verwijdert. Vol goede moed ben ik met mijn beperkte kennis van macro's begonnen om met behulp van het internet tot een oplossing te komen.

Ik heb de code vooralsnog werkend op 1 onderdeel na:

- Hij vraagt welke code ik zoek
- Vervolgens begint hij in het eerste blad te zoeken
- De gevonden code's worden gekleurd
- Er volgt een box of je de rijen wil verwijderen (OK/Cancel)
- Bij OK gaat hij verder naar het volgende blad waarna alles overnieuw gebeurt (volgens mij....)

Dan krijg ik wel weer de box met de vraag of ik de gevonden rijen wil verwijderen maar ik zou ook graag willen dat excel het betreffende blad laat zien. Hierbij ervan uitgaande dat je dan de selectie kan zien en kan beoordelen of ze in dit blad ook daadwerkelijk weg moeten.

Is dit mogelijk?

Daarnaast zou ik willen dat hij bij Cancel ook verder gaat naar het volgende blad i.p.v. de macro stopt.
Maar dan zou ik ook willen dat hij de kleur weer weghaalt voordat hij het nieuwe blad gaat bekijken.

Deze code heb ik momenteel bij elkaar gesprokkeld......

Sub ZoekCode()
'deze wist de rijen met opgegeven waarde in opgegeven kolom

  Dim MeVal    As Variant
  Dim rUnion As Range, resultaat As Range, FirstAddress As String
  
  MeVal = InputBox("Welke code zoeken?", "Zoekwaarde opgeven", Code)

For I = 1 To ActiveWorkbook.Worksheets.Count '- 5
        With Sheets(I).Cells
    'Set resultaat = .Find(MeVal, lookat:=xlPart)
    Set resultaat = .Find(MeVal, lookat:=xlWhole, MatchCase:=False)
    If Not resultaat Is Nothing Then
      FirstAddress = resultaat.Address
      Set rUnion = resultaat
      Do
        ActiveSheet.Activate

        Set rUnion = Union(rUnion, resultaat)
        Set resultaat = .FindNext(resultaat)
      Loop While Not resultaat Is Nothing And resultaat.Address <> FirstAddress
    End If

  End With
      With rUnion.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
  Response = MsgBox("De volgende rijen zullen worden verwijderd : " & rUnion.EntireRow.Address, vbOKCancel)
  If Response = vbCancel Then Exit Sub
        'With rUnion.Interior
        '    .Pattern = xlNone
        '    .TintAndShade = 0
        '    .PatternTintAndShade = 0
        'End With
  
  If Response = vbOK Then

  rUnion.EntireRow.Delete Shift:=xlUp
  End If

Next I

End Sub

Het weergeven van het volgende blad lukt me dus niet en het weer weghalen van de kleuren ook niet bij Cancel. Ben al de hele dag bezig maar verder dan dit ben ik nog niet gekomen.

 

[Figaro75]

Code liep niet helemaal goed als de zoekterm niet werd gevonden dus bij deze alvast een 'betere' code die ik heb samengesteld.
Het kan misschien makkelijker maar van VBA heb ik niet echt veel kaas van gegeten, sorry.

Sub ZoekCode2()
'deze wist de rijen met opgegeven waarde in opgegeven kolom

  Dim MeVal    As Variant
  Dim rUnion As Range, resultaat As Range, FirstAddress As String
  
  MeVal = InputBox("Welke code zoeken?", "Zoekwaarde opgeven", Code)

For I = 1 To ActiveWorkbook.Worksheets.Count '- 5
        With Sheets(I).Cells
    'Set resultaat = .Find(MeVal, lookat:=xlPart)
    Set resultaat = .Find(MeVal, lookat:=xlWhole, MatchCase:=False)
    If Not resultaat Is Nothing Then
      FirstAddress = resultaat.Address
      Set rUnion = resultaat
      Do
        ActiveSheet.Activate

        Set rUnion = Union(rUnion, resultaat)
        Set resultaat = .FindNext(resultaat)
      Loop While Not resultaat Is Nothing And resultaat.Address <> FirstAddress
  'End With
        With rUnion.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
        End With
  Response = MsgBox("De volgende rij(en) zal/zullen worden verwijderd : " & rUnion.EntireRow.Address, vbOKCancel)
  If Response = vbCancel Then Exit Sub
        'With rUnion.Interior
        '    .Pattern = xlNone
        '    .TintAndShade = 0
        '    .PatternTintAndShade = 0
        'End With
  
  If Response = vbOK Then

  rUnion.EntireRow.Delete Shift:=xlUp
  End If

  
  End If
    If resultaat Is Nothing Then
    MsgBox ("Code niet gevonden")
    End If
End With

Next I

End Sub

 

[Figaro75]

Niemand die mij kan helpen??

 

[Warme bakkertje]

Plaats eens een voorbeeldbestand dat de situatie weergeeft zodat wij iets hebben om mee te werken.

 

[Figaro75]

Het is de bedoeling dat deze macro in het persoonlijke werkblad komt te staan zodat deze macro altijd werkt.
Mijn collega maakt mbv een gps-station coördinaten aan met daaraan een korte omschrijving dmv een code.
Deze wordt als txt bestand uitgelezen uit het station en vervolgens in excel geïmporteerd.
Deze meting wordt verstrekt aan derden maar bepaalde codes wil hij dus niet delen (extra punten die hij registreert).
Nu moet hij zelf heel de lijst afzoeken en de rijen handmatig verwijderen.

Nu was zijn vraag of dit ook automatisch kan als hij in het hele bestand kan zoeken op een bepaalde code en zodra deze gevonden wordt de gehele rij wordt verwijdert.

Door middel van de code in mijn 2e post kan je dus door het starten van de macro 'ZoekCode2' zoeken op een specifieke tekst, waarna hij per blad gaat zoeken op die waarde, deze selecteert, aangeeft welke rijen het betreft en vervolgens de vraag stelt of de rijen verwijdert moeten worden.
Dit werkt en hij gaat ook op zoek in het volgende blad en vindt dan bv de zoekterm, markeert deze, en geeft de melding welke rijen het betreft en of ze verwijdert moeten worden.
Hij wisselt alleen niet fysiek van beeld, dus excel blijft het blad weergeven waar je de macro hebt gestart.

Dus er is geen voorbeeldbestand in die zin.......omdat er dus altijd een txt bestand wordt geïmporteerd.
Vandaar mijn idee om deze code dus in het personal workbook te plaatsen.
We willen in principe ook niet dat deze zoekmacro in het te leveren bestand komt te zitten ook omdat de export niet altijd een xls bestand zal zijn.

Ik test de macro door geheel willekeurig in een aantal cellen (verspreid over kolommen, rijen en bladen) wat teksten te plaatsen, te zoeken en rijen te verwijderen.

De macro werkt maar er zijn dus nog wat wensen:

1. bij meerdere werkbladen steeds het doorzochte blad weergeven als de melding wordt gegeven welke rijen er zullen worden verwijdert;
2. als bij een werkblad wordt gekozen voor niet verwijderen dat hij verder gaat naar het volgende blad (misschien Yes en No gebruiken ipv Yes en Cancel?)
3. dat als je dus Cancel (of Nee/No) kiest dat hij de selectie weer demarkeert en naar het volgende blad gaat.

Maar 1 krijg ik dus niet voor elkaar en ik ga proberen of No ipv Cancel bij 2/3 beter is.
Maar moet eerst even excel weer installeren want ik heb net mijn laptop opnieuw geïnstalleerd....

 

[Figaro75]

Ik heb dus zelf ook geen voorbeeld van mijn collega (ook niet om gevraagd hoor....) omdat het dus puur om automatisch zoeken gaat en complete rijen verwijderen.
Dus het maakt geheel niet uit hoe het bestand eruit ziet.
Na de import bestaat het natuurlijk wel uit meerdere kolommen met waarden, o.a. x-, y-, en z-coördinaten en dus blijkbaar bepaalde codes.

Hoop dat jullie met deze aanvullende gegevens iets kunnen.

 

[Warme bakkertje]

Sheets(I).Activate

 

[Warme bakkertje]

  If MsgBox("De volgende rij(en) zal/zullen worden verwijderd : " & rUnion.EntireRow.Address, vbYesNo) = vbOK Then
      rUnion.EntireRow.Delete Shift:=xlUp
  Else
      With rUnion.Interior
          .Pattern = xlNone
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
  End If

 

[Figaro75]

Zet ik dat na Do i.p.v. activesheet.activate ?

 

[Figaro75]

Dus idd No ipv Cancel gebruiken.....

 

[Figaro75]

  If MsgBox("De volgende rij(en) zal/zullen worden verwijderd : " & rUnion.EntireRow.Address, vbYesNo) = [COLOR="#FF0000"][B]vbOK[/B][/COLOR] Then
      rUnion.EntireRow.Delete Shift:=xlUp

Ik heb vbOK aangepast naar vbYes en dan werkt het, mijn dank is groot.
Hoop dat het een beetje is wat mijn collega wil.

Ga nog even kijken of ik in het werkblad kan scrollen in afwachting van Ja/Nee selectie.
Dat zat toch ergens in die linker kolom verstopt...ga even zoeken.....

 

[Warme bakkertje]

Oeps foutje
Als antwoord op je laatste vraag: neen gaat niet.

 

[Figaro75]

Als antwoord op je laatste vraag: neen gaat niet.

Dan stop ik meteen met zoeken......

Sheets(I) was ik nog niet opgekomen dus dat ene foutje van jou valt in het niet bij het gerommel van mij.......
Morgen op kantoor kijken of mijn collega er is en het is wat hij wil. Vindt het zelf wel een aardig gelukt idee met jouw hulp, waarvoor mijn dank.
Nog 1 ding proberen (had ik op mijn werk al bijna werkend) om te kijken of dat nu ook werkt maar moet even mijn bestand van mijn werk ophalen.

ALs het werkt zal ik de complete code even plaatsen voor andere die het misschien handig vinden en dan het topic op afgerond zetten.

 

[Figaro75]

Voor een ieder die het ook wel makkelijk vindt om complete rijen te laten verwijderen bij het zoeken naar een bepaalde zoekterm.
Met hulp van @Warme bakkertje, bedankt Rudi.

Sub ZoekCode()
'deze macro wist de complete rijen bij het vinden van een in te geven zoekwaarde in het gehele werkblad

  Dim MeVal    As Variant
  Dim rUnion As Range, resultaat As Range, FirstAddress As String
  
  MeVal = InputBox("Welke code wil je zoeken?", "Zoekwaarde opgeven", Code)

For I = 1 To ActiveWorkbook.Worksheets.Count
        With Sheets(I).Cells
    'Set resultaat = .Find(MeVal, lookat:=xlPart)
    Set resultaat = .Find(MeVal, lookat:=xlWhole, MatchCase:=False)
    If Not resultaat Is Nothing Then
      FirstAddress = resultaat.Address
      Set rUnion = resultaat
      Do
        Sheets(I).Activate

        Set rUnion = Union(rUnion, resultaat)
        Set resultaat = .FindNext(resultaat)
      Loop While Not resultaat Is Nothing And resultaat.Address <> FirstAddress
 
        With rUnion.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
        End With
  If MsgBox("De code is in " & Sheets(I).Name & " gevonden" & Chr$(13) & "Wil je de volgende rij(en) verwijderen : " & rUnion.EntireRow.Address & " ?", vbYesNo) = vbYes Then
      rUnion.EntireRow.Delete Shift:=xlUp
  Else
      With rUnion.Interior
          .Pattern = xlNone
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
  End If
End If
    If resultaat Is Nothing Then
    MsgBox ("In " & Sheets(I).Name & " is de gezochte" & Chr$(13) & "code niet gevonden!")
    End If
End With

Next I

End Sub