Sheet laadt andere gegevens dan gewild

[gl3nn1987]

Heren,

De eerste sheet laadt meer gegevens dan hij zou moeten. Hij laadt voor alle waarden die niet voldoen aan de criteria gewoon andere en als ik 2x dezelfde artiest in de database plaatst dan pakt ie gewoon voor alle records deze gegevens. Heeft iemand daar een oplossing voor. Ik kan de fout niet vinden in code:

Private Sub Worksheet_Activate()
'Dag
Dim dag As Integer
Dim podium As Integer
dag = 1
podium = 1
Dim Zoekwaarde As String
Dim resultaat As String
Dim ArtiestZoekwaarde As String
Dim Artiest As String
Dim Artiestdag As String
Dim Artiestpodium As String
Dim ArtiestTijd As String


'Verwijderen
Sheets("Dag " & dag & " Podium " & podium).Range("A2:A" & Sheets("Dag " & dag & " Podium " & podium).Range("A65536").End(xlUp).Row + 1).Resize(, 3).Clear


'opbouwen
For Each c In Sheets("Database").Range("A2:A" & Sheets("Database").Range("A65536").End(xlUp).Row)
    'cache legen
    Msg = ""
    resultaat = ""
    ArtiestZoekwaarde = ""
    Artiest = ""
    Artiestdag = ""
    Artiestpodium = ""
    ArtiestTijd = ""
        
    'zoek de artiestgegevens bij het tabblad artiesten gelijk aan c
        ArtiestZoekwaarde = c
            If Not Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde) Is Nothing Then
                If Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde).Offset(, 2) = dag And _
                Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde).Offset(, 3) = podium Then
                    With Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde)
                    Artiest = .Offset(, 1)
                    Artiestdag = .Offset(, 2)
                    Artiestpodium = .Offset(, 3)
                    ArtiestTijd = .Offset(, 4)
                    End With
                Zoekwaarde = c.Offset(, 2)
                    If Not Sheets("DrankenVoedsel").Range("A2:A" & Sheets("DrankenVoedsel").Range("A65536").End(xlUp).Row).Find(Zoekwaarde) Is Nothing Then
                    resultaat = Sheets("DrankenVoedsel").Range("A2:A" & Sheets("DrankenVoedsel").Range("A65536").End(xlUp).Row).Find(Zoekwaarde).Offset(, 1)
                    Else
                    MsgBox "Drank/Voedsel waarde komt niet voor in de tabel"
                    End If
                Msg = c.Offset(, 1) & " " & resultaat
                With Sheets("Dag " & dag & " Podium " & podium).Range("A2:A" & Sheets("Dag " & dag & " Podium " & podium).Range("A65536").End(xlUp).Row)
                .Offset(1, 0) = Artiest
                .Offset(1, 1) = ArtiestTijd
                .Offset(1, 2) = Msg
                End With
                End If
            Else
            MsgBox "Artiest komt niet voor in de tabel"
            End If
Next
End Sub

Zie bijlage....Bekijk bijlage test(Hmij).xls.xlsm

 

[Demeter]

je plak bereik in je laatste with functie is niet correct.
Je begint hier je bereik iedere keer vanaf cel A2 tot aan nieuwe regel.
Je plakt dus de nieuwe regel over de al bestaande regel + nog 1x extra.

Als je A2: weg haalt uit je regel dan werkt het ok.

With Sheets("Dag " & dag & " Podium " & podium).Range("A2:A" & Sheets("Dag " & dag & " Podium " & podium).Range("A65536").End(xlUp).Row)

Volledige code wordt (zonder er verder inhoudelijk naar te kijken)

Private Sub Worksheet_Activate()
'Dag
Dim dag As Integer
Dim podium As Integer
Dim Zoekwaarde As String
Dim resultaat As String
Dim ArtiestZoekwaarde As String
Dim Artiest As String
Dim Artiestdag As String
Dim Artiestpodium As String
Dim ArtiestTijd As String

    dag = 1
    podium = 1
    
    'Verwijderen
    Sheets("Dag " & dag & " Podium " & podium).Range("A2:A" & Sheets("Dag " & dag & " Podium " & podium).Range("A65536").End(xlUp).Row + 1).Resize(, 3).Clear

    'opbouwen
    For Each c In Sheets("Database").Range("A2:A" & Sheets("Database").Range("A65536").End(xlUp).Row)
        'cache legen
        Msg = ""
        resultaat = ""
        ArtiestZoekwaarde = ""
        Artiest = ""
        Artiestdag = ""
        Artiestpodium = ""
        ArtiestTijd = ""
            
        'zoek de artiestgegevens bij het tabblad artiesten gelijk aan c
        ArtiestZoekwaarde = c
        
        If Not Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde) Is Nothing Then
                
            With Sheets("Artiesten").Range("A2:A" & Sheets("Artiesten").Range("A65536").End(xlUp).Row).Find(ArtiestZoekwaarde)
                Artiest = .Offset(, 1)
                Artiestdag = .Offset(, 2)
                Artiestpodium = .Offset(, 3)
                ArtiestTijd = .Offset(, 4)
            End With
            
            Zoekwaarde = c.Offset(, 2)
            
            If Not Sheets("DrankenVoedsel").Range("A2:A" & Sheets("DrankenVoedsel").Range("A65536").End(xlUp).Row).Find(Zoekwaarde) Is Nothing Then
                resultaat = Sheets("DrankenVoedsel").Range("A2:A" & Sheets("DrankenVoedsel").Range("A65536").End(xlUp).Row).Find(Zoekwaarde).Offset(, 1)
            Else
                MsgBox "Drank/Voedsel waarde komt niet voor in de tabel"
            End If
            
            If Artiestdag = dag And Artiestpodium = podium Then
                With Sheets("Dag " & dag & " Podium " & podium).Range("A" & Sheets("Dag " & dag & " Podium " & podium).Range("A65536").End(xlUp).Row)
                    .Offset(1, 0) = Artiest
                    .Offset(1, 1) = ArtiestTijd
                    .Offset(1, 2) = c.Offset(, 1) & " " & resultaat
                End With
            End If
            
        Else
            MsgBox "Artiest komt niet voor in de tabel"
        End If
        
    Next

End Sub

 

[gl3nn1987]

Ahh serieus. Zo domme fout gewoon ik heb denl een uur lang alles erboven nagelopen. Maar reuze bedankt!

 

[Demeter]

No problemo.

Graag nog de vraag op opgelost zette aub.

prettige avond.