worksheet change event in 1 keer in alle tabbladen

[oeldere]

Beste forumleden,

gegegevens worden opgehaald en geplaatst in een nieuw werkblad in een Combine Sheet (met de vooraf bepaalde bestandsnaam maandoverzicht).

vervolgens worden met de code van Ron de Bruin, de unieke gegevens (van een kolom) verdeeld over de tabbladen.

Op dit bestand zou ik graag voor alle werkbladen een change event laten plaatsvinden.

Als bijlage een fictief voorbeeld.

De change event in de combine sheet heb ik er nu zelf handmatig in gekopieerd.

1) Hoe is deze er automatisch (met VBA) in dit bestand te krijgen?

2) Hoe dien ik de code aan te passen zodat de change event code op alle werkbladen wordt toegepast?

Heb je vragen of overige opmerkingen, laat het gewoon even weten.

alle hulp is welkom.

 

[Warme bakkertje]

Plaats deze in ThisWorkbook, dan geldt deze voor alle werkbladen.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$C$1" And Target <> "" Then
   Range("c3:c7500").AutoFilter Field:=3, Criteria1:=Range("C1").Value '& "*" dit toevoegen als het tekst is / field is kolom
  Else: ActiveSheet.AutoFilterMode = False
 End If
End Sub

 

[oeldere]

Beste Warm bakkertje,

ik ga de code zometeen proberen.

is er ook een mogelijkheid om deze code (b.v. via VBA) in een nieuw (leeg) bestand te plaatsen?

code geplaatst in ThisWorkbook en het werkt perfect. :thumb::thumb:

 

[snb]

Range("c3:c7500").AutoFilter Field:=[COLOR="red"]3[/COLOR], Criteria1:=Range("C1").Value

??

Range("c3:c7500").AutoFilter [COLOR="red"]1[/COLOR], Range("C1").Value

 

[oeldere]

Beste SNB,

ik begrijp je antwoord niet.

AutoFilter Field:=3

dit geeft in mijn beleving aan dat je selecteert op kolom 3 (is de C-kolom).

waarom zou dit gewijzigd moeten worden in onderstaande code.

AutoFilter 1

ik ben er zeker van dat je daar een goede reden voor hebt, maar ik begrijp hem niet.

wil je dit nog even uitleggen?

 

[Warme bakkertje]

Sub Insert_Procedure_ThisWorkbook()
Dim cdModule As VBIDE.CodeModule, lnRow As Long
Dim stSubName As String, stProcedure As String, stEnd As String
Dim stTab As String, stNewRow As String

stTab = Chr(9)
stNewRow = Chr(13)
stEnd = "End Sub"

stSubName = "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" & stNewRow

stProcedure = "If Target.Address =" & """$C$1""" & " And Target <>" & """""" & " Then" & stNewRow

stProcedure = stProcedure & _
stTab & "Range(" & """C3:C7500""" & ").AutoFilter Field:=3, Criteria1:=Range(" & """C1""" & ").Value '" & """*""" & " dit toevoegen als het tekst is / field is kolom" & stNewRow

stProcedure = stProcedure & _
stTab & "Else: ActiveSheet.AutoFilterMode = False" & stNewRow

stProcedure = stProcedure & _
"End If" & stNewRow

'In actief bestand invoegen
'Set cdModule = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

'In nieuw bestand invoegen
Set cdModule = Workbooks.Add.VBProject.VBComponents("ThisWorkbook").CodeModule

With cdModule
lnRow = .CountOfLines + 1
.InsertLines lnRow, stSubName & stProcedure & stEnd
End With
End Sub

Niet vergeten om bij Verwijzingen 'Microsoft Visual Basic for Applications Extensibility 5.3' aan te vinken alvorens de code te gebruiken.

 

[oeldere]

Niet vergeten om bij Verwijzingen 'Microsoft Visual Basic for Applications Extensibility 5.3' aan te vinken alvorens de code te gebruiken.

deze verwijzingen heb ik wel eens gezien, maar waar zitten ze ook weer precies.

ik werk met excel 2007.

uiteraard bedankt voor de code, ik ga hem daarna proberen.

 

[Warme bakkertje]

In VB-Editor Extra >> Verwijzingen

 

[snb]

Het gebied gaat alleen over kolom C.
Een kolom heeft slechts 1 veld.
autofilter 3 verwijst naar het derde veld van het te filteren gebied. Dat derde veld bestaat niet in kolom C.
het nummer 3 gaat dus niet over het kolomnummer, maar over het derde veld in een gebied. Wlke veldnummer je moet gebruiken is dus helmaal afhankleijk van het gebied waarop je filtert.

 

[snb]

Misschien iets eenvoudiger code om de macro in een nieuw werkboek te zetten; ervan uitgaande dat het huidige werkboek deze code bevat:

Sub snb_001()
  With ThisWorkbook.VBProject.VBComponents(1).CodeModule
    c01 = .Lines(1, .CountOfLines)
  End With
  With Workbooks.Add
    .VBProject.VBComponents(1).CodeModule.AddFromString c01
  End With
End Sub

 

[oeldere]

@warm bakkertje

ik krijg een foutmelding op deze regel.

'In actief bestand invoegen
Set cdModule = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

wat is hiervan de reden?

@SNB

met jouw code ga ik vanavond aan de slag.
uiteraard zal ik je mijn bevindingen (en vragen) zeker laten weten.
alvast bedankt.

P.s. het huidige bestand heeft niet deze code in this worbook.

 

[oeldere]

'Microsoft Visual Basic for Applications Extensibility 5.3' is in beide bestanden geaktiveerd.

'In actief bestand invoegen
Set cdModule = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule

ik blijf toch de foutmelding op deze code houden!

 

[Warme bakkertje]

Welke foutmelding ?

 

[oeldere]

@warm bakkertje

bedankt voor de reactie

fout 1004 tijdens uitvoering

Toegang tot het Visual Basic-Project op programmeerniveau is niet betrouwbaar.

 

[Warme bakkertje]

Ontwikkelaars >> Macrobeveiliging >> Macroinstellingen voor ontwikkelaars >> Toegang tot het objectmodel .... aanvinken

 

[oeldere]

@warm bakkertje

uiteraard had ik je meteen de foutcode erbij moeten zijn, sorry daarvoor.

het geheel getest en het werkt perfect.

ik vind dit superknap :thumb::thumb:

bedankt voor de hulp.

 

[oeldere]

vaste cel gebruiken als basis voor filteren in aparte werkbladen

Tenslotte wil ik nog graag dat in het bestandje de filters automatisch op de tabbladen worden aangezet bij een wijziging van cel c1 op de combine sheet.

Dus op combine sheet wordt in cel c1 de waarde 6 ingevuld.

vervolgens op alle tabbladen de filters aktiveren op basis van 6.

nu de change event aanwezig is moet dit volgens mij gaan werken.

maar welke code heb ik nu nodig om de waarden in de afzonderlijke tabbladen met 6 gevuld te krijgen, waarna daarna de change event ook werkt.

wie kan me daar nog bij helpen.

wederom is alle hulp welkom.

heb je aanvullende vragen, laat het dan gewoon even weten.

 

[snb]

Deze code levert hetzelfde resultaat

sub maak_macro_snb()
  With Workbooks.Add
    .VBProject.VBComponents(1).CodeModule.AddFromString replace(replace("Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)~Range(#c3:c7500#).AutoFilter 1, cells(1,3)~End Sub","~",vbCr),"#",chr(34))
  End With
end sub

 

[oeldere]

@SNB

ik krijg de code in een nieuw werkbook geplaatst (dus uiteraard) werkt je oplossing.

~End Sub","~",vbCr),"#",chr(34))

Wil je me het laatste stuk van de code uitleggen?

wat doet het laatste stuk van de code?

 

[Warme bakkertje]

Dit zijn onderdelen v/d functie Replace.
Elke tilde '~' wordt bij de uitvoering vervangen door een Enter en zorgt er dan voor dat een nieuwe regel begonnen wordt.
Elke '#' wordt vervangen door ' " ' bij uitvoering en zorgt dus voor de dubbele aanhalingstekens bij het Range-object.