VBA activeren indien binnen een vast bereik zich een vaste tekst voordoet

[Robert Smidt]

Beste Helpmij'ers,

Ik ben op zoek naar een code (Excel/vba) indien binnen een bereik van (H62 t/m H162) de tekst "Druk op vullen en sorteren" zich voordoet; de code (Application.Run "Validatie") geactiveerd wordt.

Een antwoord zie ik met veel belangstelling tegemoet.

Robert

 

[edmoor]

Daar gaan een aantal vragen over het hoe, wat, waar en wanneer over komen. Je kan beter een voorbeeld plaatsen.

 

[Robert Smidt]

Bekijk bijlage Binnen bereik.xlsm

Ik heb de inhoud naar een nieuw bestand gezet (origineel is erg groot) zodat je een idee hebt wat er moet gebeuren. Het gaat mij er om dat er een d.m.v. een code (mijn vraag) een bestaande code (Application.Run "Validatie") wordt geactiveerd.

Hopelijk kun je hiermee uit de voeten, alvast bedankt.

 

[edmoor]

Maar door wat en wanneer moet de tekst "Druk op vullen en sorteren" gedetecteert worden?
Het kan bijvoorbeeld met zoiets:

    Dim VulSort As Range
    Set VulSort = Range(Cells.Find(What:="Druk op vullen en sorteren", _
        After:=ActiveCell, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False, _
        SearchFormat:=False).Address)

Dan heb je het Range object VulSort met o.a. de cel waar die tekst is gevonden.

 

[VenA]

Volgens mij staat er geen code in het bestand en een tabel met verwijzingen naar een extern bestand werkt ook niet lekker.

Mogelijk bedoel je zoiets

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, ListObjects(1).DataBodyRange.Columns(1)) Is Nothing Then Exit Sub
  If Target = "Druk op vullen en sorteren" Then Call VenA
End Sub

Sub VenA()
  MsgBox "Druk op vullen en sorteren"
End Sub

 

[Robert Smidt]

De code werkt wanneer ik in de betreffende cel ga staan waar (Druk op vullen en sorteren) staat. Het is mijn bedoeling dat de code actief wordt wanneer er willekeurig in kolom H voornoemde tekst staat.

Ik begrijp dat het lastig is omdat ik niet het volledige bestand kan meesturen. Mijn code begint overigens met:

Private Sub Worksheet_Change(ByVal Target As Range)

Kan het ook zijn dat ik meer in de richting van:

If Not IsError(Application.Match(Cells(Target.Row, 6), range ("H62:H162"), 0)) then

moet zoeken en dan i.p.v. target.row, 6 wijzigen in: (Druk op vullen en sorteren)?

 

[HSV]

Wil je dit na elke change_gebeurtenis?
Zo ja, in welke kolom doe je een wijziging?

Of moet het automatisch als de formules bijgewerkt worden?
Doe dan ipv de change_event de calculate_event.

 

[Robert Smidt]

de wijziging vindt plaats in kolom C afhankelijk van wat daar gebeurt kan het zijn dat in kolom H (Druk op vullen en sorteren) komt te staan. Wanneer dat gebeurt moet een vba in werking gesteld worden.

Ik zelf zat ook nog even te zoeken en kwam het volgende tegen:

For Each cell In Range("h62:h162")
If cell.Value Like "Druk op vullen en sorteren" Then MsgBox "Druk op vullen en sorteren"
Next

Deze heb ik wat aangepast, alleen werkt ook niet.

 

[HSV]

Je vorige vind ik beter.

If Not IsError(Application.Match("Druk op vullen en sorteren", Range("H62:H162"), 0)) Then

 

[Robert Smidt]

If Not IsError(Application.Match("Druk op vullen en sorteren", Range("h62:H162"), 0)) Then MsgBox "Druk op vullen en sorteren"

Deze code werkt alleen wanneer ik muteer in kolom h en werkt niet wanneer ik muteer in kolom c. Wat zou ik daar aan kunnen veranderen?

 

[HSV]

Volgens het voorbeeldbestand zit daar niet de tabel, dus daar niet van uitgaande.

Private Sub Worksheet_Change(ByVal Target As Range)
  If not Intersect(target,columns(3)) Is Nothing Then
  [COLOR=#3E3E3E]If Not IsError(Application.Match("Druk op vullen en sorteren", Range("h62:H162"), 0)) Then MsgBox "Druk op vullen en sorteren"
end if[/COLOR]
End Sub

 

[Robert Smidt]

Helaas werkt de code niet. Maar je hebt helemaal gelijk dat mijn vorige bestand niet volledig is, ik doe jou bij deze een uitgebreider werkblad toekomen. Ik ging ervan uit dat de vorige bijlage voldoende was en realiseer mij dat dit voor jullie lastig is...sorry. Ik hoop dat je iets meer kunt met dit bestand.Bekijk bijlage Binnen bereik.xlsm

 

[HSV]

Als zoiets als dit.....

If Intersect(Target, ListObjects(1).DataBodyRange.Columns(1)) Is Nothing Then Exit Sub
If Target = "Druk op vullen en sorteren" Then MsgBox "Druk op vullen en sorteren"
   ' If Target = "Ja" Then MsgBox "Druk op vullen en sorteren"

.....midden in een code staat tussen nog meer van zijn soort, dan gebeuren er twee dingen.

1: De code wordt afgebroken door Exit Sub.
2: De code werkt niet eerder weer voordat Excel opnieuw is opgestart.
Application.enableevents gaat niet weer op True.

 

[Robert Smidt]

Dat was even niet zo slim van mij

Ik heb de vorige code verwijderd en volgens mij werkt deze nu naar volle tevredenheid. Morgen ga ik nog even verder experimenteren.

Heel erg bedankt voor de tijd en moeite, ben hier weer eens super blij mee...:thumb: