validate listeboks skal køre en makro

Put denne i arkets kodemodul (højreklik på fane - vælg Vis programkode)
Valliste i A1

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If Target = "Valg.1" Then Call Makro1
If Target = "Valg.2" Then Call Makro2
End Sub

Hvordan går det ?

Var nok ikk klar nok i min beskrivelse .... er samme makro der skal køres uanset hvad der vælges, da den fjener tommelinjer :-)

Hele min kode ser sådan her ud ..... meningen er at den commandbutton jeg har skal bare aktiveres hver gang man har foretaget et valg

'Skjul tomme linjer
Private Sub CommandButton1_Click()
'Slukker skærmopdatering
Application.ScreenUpdating = False
'Slukker automatisk genberegning
Application.Calculation = xlCalculationManual


Rows("14:191").Select
Selection.EntireRow.Hidden = False

i = 14

Do While i < 192
    If Cells(i, 1) = 0 Then
        Rows(i).Select
        Selection.EntireRow.Hidden = True
    End If
   
   
   
    i = i + 1
Loop
'tænder for automatisk genberegning
Application.Calculation = xlCalculationAutomatic
'tænder for skærmopdatering
Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic
End Sub
'Vis alle linjer
Private Sub CommandButton2_Click()
Rows("14:191").Select
Selection.EntireRow.Hidden = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Ret A1 til den celle hvor du har datavalliste
Så kører din kode uanset hvad du vælger i datavallisten

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Call CommandButton1_Click
End Sub

Jeg har nu lagt den ind i bunden .... men det virker ikk :-(

Jeg får nu en Compile error:

Ambigous name detected:worksheet_change

er stået helt af hehe :-))

Du skal bare slette disse linier
der må ikke være 2 ens sub's

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Så er det rettet ... men den virker stadig ikk ?? sker ikk noget ... når man skifter valg i boksen .....

ok:
Hvad hedder Arket hvor du har din validate-listboks ?
I hvilken celle har du din validate-listboks ?

Det hedder Ark1 og cellen hedder d6 (har rettet a1 til d6) du får lige hele koden igen som den ser ud nu :-)

Private Sub CommandButton1_Click()
'Slukker skærmopdatering
Application.ScreenUpdating = False
'Slukker automatisk genberegning
Application.Calculation = xlCalculationManual


Rows("14:191").Select
Selection.EntireRow.Hidden = False

i = 14

Do While i < 192
    If Cells(i, 1) = 0 Then
        Rows(i).Select
        Selection.EntireRow.Hidden = True
    End If
   
   
   
    i = i + 1
Loop
'tænder for automatisk genberegning
Application.Calculation = xlCalculationAutomatic
'tænder for skærmopdatering
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click()
Rows("14:191").Select
Selection.EntireRow.Hidden = False

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Call CommandButton1_Click


End Sub

oka rettelsen var der så ikk ... så har nu rettet a1 til d6 igen ... hehe.. og nu ... tja ... nu opdatere den godt nok .. men jeg kan ikke vælge noget fra boksen.. hvergang jeg klikker på den for at få listen frem opdateren den og listen forsvinder før jeg kan vælge noget hehe..... så det er for tidligt den opdaterer

du er velkommen til at sende arket til
pm@madsen.tdcadsl.dk

slet lige denne :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Call CommandButton1_Click
End Sub

og udskift med denne :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D6")) Is Nothing Then Exit Sub
Call CommandButton1_Click
End Sub

og jeg går ud fra at det er "CommandButton1_Click"
og ikke "CommandButton2_Click" som skal køres når du vælger i D6 ?

Weeeeeeee det virker sgu :-) og ja var knap 1 :-)) tak points er hermed givet til dig :-)

OK VELBEKOM :-)