Boekenlijst in excel

11221122 · 20 okt 2010

Hallo,

Ik heb een boeklijst in excel gemaakt. Dit ziet er als volgt uit:
Blad1: Start - Kan je zoeken op auteur of titel en boeken toevoegen dmv een userform
Blad2: Titel - Staan boeken gesorteerd op titel
Blad3: Auteur - Staan boeken gesorteerd op auteur.

Als ik een boek wil toevoegen klikt ik in Start op 'Boek Toevoegen' vervolgens opent zich een userform met: Titel en Auteur. Als ik op toevoegen klik voegt hij het boek toe aan de lijst waar titel op alfabet staat en ook waar de auteur op alfabeth staat. Daarna voert hij in de macro ook uit dat hij opnieuw op alfabeth gaat want anders staat het toegevoegde boek gewoon onderaan de lijst. Dit is de code:

Code:

Sub CommandButton1_Click()
  With Sheets("Titel").Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen in lijst gesorteert op titel
    .Offset(1) = TextBox1.Text
    .Offset(1, 4) = TextBox2.Text
  End With

    With Sheets("Auteur").Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen in lijst gesorteerd op auteur
    .Offset(1, 3) = TextBox1.Text
    .Offset(1) = TextBox2.Text
  End With
  Me.TextBox1 = "" 'Textboxen leeg maken
  Me.TextBox2 = ""
  UserForm1.Hide
  
    Range("A2:H394").Select 'Sorteren op titel
    ActiveWorkbook.Worksheets("Titel").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Titel").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Titel").Sort
        .SetRange Range("A2:H394")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J5").Select
    Sheets("Zoeken").Select
    Range("A1").Select
    
        Range("A2:G394").Select 'Sorteren op auteur
    ActiveWorkbook.Worksheets("Auteur").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Auteur").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Auteur").Sort
        .SetRange Range("A2:G394")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J5").Select
    Sheets("Zoeken").Select
    Range("A1").Select
    

    
End Sub

In de boekenlijst heb ik met voorwaardelijke opmaak ingesteld dat als een boek 2 of meer keer voor komt hij de regel geel kleurt. Dit werkt. Ik wil nu alleen ook dat hij aangeeft als ik een boek toevoeg. Iets dergelijks van; Boek bestaat al. Is dit mogelijk?

Mvg.

BESTAND: http://www.mijnbestand.nl/Bestand-P4UUZNSXTAGZ.xlsm

11221122 · 20 okt 2010

Iemand??

trucker10 · 20 okt 2010

Als je zo een macro kan in elkaar boxen dan moet het ene kleintje zijn om een LookIn en LookAt:=xlWhole macrootje toe te voegen . Maar aan wat ik gisteravond zag en las begin ik er vandaag niet aan , sorry ik laat het aan de andere helpers over .
Ik zou zeggen doe Rene de groetjes voor zijn bestandje

11221122 · 20 okt 2010

Deze macro heb ik niet uit mn hoofd inelkaar 'geboxt'. Ik heb stukjes code opgenomen. Dus letterlijk voordoen en dat hij het opneemt. En de rest wist ik wel.

Maar het stukje dat ik nu zoek kan ik niet opnemen dus moet ik wel zelf de code typen. Opzich is dit geen probleem. Maar ik weet de code niet die je daar voor moet gebruiken. Is er anders een website waar diverse codes/formules staat beschreven?

Het enige wat ik nu voor code moet hebben is als de waarde al voor komt in het bereik moet hij , nadat ik op toevoegen klik, een melding geven in trent van 'Dit boek is al aanwezig in de lijst'.

Mvg.

Warme bakkertje · 21 okt 2010

Dit helpt je vast op weg

Code:

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else
        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
    End If
  End With

11221122 · 21 okt 2010

Kan je iets met een voorbeeldbestand posten? Ik heb de code verwerkt maar ik krijg na een paar keer aanpassen verschillende errors....

trucker10 · 21 okt 2010

Werkt goed

Code:

Sub CommandButton1_Click()
[COLOR="red"] ' With Sheets("Titel").Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
  '  .Offset(1) = TextBox1.Text
   ' .Offset(1, 4) = TextBox2.Text
 ' End With[/COLOR]
On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else
        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
    End If

IK heb het rode vervangen door de code van Rudi
On Error Resume Next , gaat de macro gewoon verder

Warme bakkertje · 21 okt 2010

Dat was idd de bedoeling :thumb:

trucker10 · 21 okt 2010

Het minpuntje in 11221122 zijn bestandje is dat hij geen activeX knopen gebruikt en dat je de knoppen terug moet koppelen aan de macro . Of zoals ik heb getest via de editor met F5 .

11221122 · 21 okt 2010

Het lukt niet. Ik heb deze code:

Code:

Sub CommandButton1_Click()

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else
        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
    End If

    With Sheets("Auteur").Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen in lijst gesorteerd op auteur
    .Offset(1, 3) = TextBox1.Text
    .Offset(1) = TextBox2.Text
  End With
  Me.TextBox1 = "" 'Textboxen leeg maken
  Me.TextBox2 = ""
  UserForm1.Hide
  
    Range("A2:H394").Select 'Sorteren op titel
    ActiveWorkbook.Worksheets("Titel").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Titel").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Titel").Sort
        .SetRange Range("A2:H394")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J5").Select
    Sheets("Zoeken").Select
    Range("A1").Select
    
        Range("A2:G394").Select 'Sorteren op auteur
    ActiveWorkbook.Worksheets("Auteur").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Auteur").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Auteur").Sort
        .SetRange Range("A2:G394")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("J5").Select
    Sheets("Zoeken").Select
    Range("A1").Select
    

    
End Sub

Maar als ik deze code gebruik geeft hij aan dat End With mist. Ik heb op verschillende plaatsen geprobeert het er tussen te zetten. Niks werkte. Behalve onderaan. Dan deed de code het wel alleen gaf hij dan bij elke titel aan dat hij al in de lijst aanwezig is. Ook de boeken die dat niet zijn....

Kan iemand mij uit de brand helpen?

trucker10 · 21 okt 2010

Dan tel je de End With en zet deze op de gepaste plaats

Code:

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else
        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
    End If
 [COLOR="blue"] End With[/COLOR]

Warme bakkertje · 21 okt 2010

Ik had deze enkel als vb gemaakt voor werkblad Titel dus

Code:

Sub CommandButton1_Click()

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else
        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
    End If
[COLOR="red"]End With[/COLOR]
    With Sheets("Auteur").Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen in lijst gesorteerd op auteur
    .Offset(1, 3) = TextBox1.Text
    .Offset(1) = TextBox2.Text
  End With
  Me.TextBox1 = "" 'Textboxen leeg maken
  Me.TextBox2 = ""
  UserForm1.Hide

11221122 · 21 okt 2010

Bedankt! Ik kon net dat stukje niet vinden waar hij moest komen. Dit is nu mijn code:

Code:

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
        MsgBox "Deze titel is al opgenomen in de lijst", vbExclamation: Exit Sub
    Else

Maar hoe kan ik aangeven dat textbox1 EN textbox2 niet mogen voorkomen in combinatie. Dus los van elkaar wel. Maar niet in combinatie. Want bijv het boek ademnood staat al in de lijst. Maar als ik hem wil toevoegen alleen dan van een andere schrijver moet dat kunnen...

Jack Nouws · 21 okt 2010

Hallo 11221122,

Misschien zoiets als dit ...

Code:

    If MsgBox("Deze titel is al opgenomen in de lijst" & vbNewLine & _
              "Wilt U deze titel toch opslaan?", vbExclamation + vbYesNo, "Bevestigen") = vbYes Then
              
             [COLOR="blue"] 'de rest van je code[/COLOR]   
    End If

Met vr gr
Jack

11221122 · 21 okt 2010

Als ik deze code gebruik:

Code:

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
       If MsgBox("Deze titel is al opgenomen in de lijst" & vbNewLine & _
              "Wilt U deze titel toch opslaan?", vbExclamation + vbYesNo, "Bevestigen") = vbYes Then

        With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
            .Offset(1) = TextBox1.Text
            .Offset(1, 4) = TextBox2.Text
        End With
   End If
        End With

End With zonder With. Maar als ik de laatste End With gehaal zegt hij weer dat hij een End With mist...

trucker10 · 21 okt 2010

Je hebt

Code:

 (1ste open ) With ........
( 1ste open ) If ...............

( 1 ste sluit )End If 

( 1 ste sluit )End With

Bij jouw

Code:

 ( 1ste open )With ............

( 1ste open ) If .............

( 2de open ) If .............

( 1 ste sluit ) End If 

          ( 2de open ) With ...............

         ( 2de sluit )End with 

( 2de sluit )End If 

( 1ste sluit ) End With

Jack Nouws · 21 okt 2010

Code:

On Error Resume Next
  With Sheets("Titel")
    If Not .Columns(1).Find(TextBox1, , xlValues, xlWhole) Is Nothing Then
       If MsgBox("Deze titel is al opgenomen in de lijst" & vbNewLine & _
              "Wilt U deze titel toch opslaan?", vbExclamation + vbYesNo, "Bevestigen") = vbYes Then

           With .Cells(Rows.Count, 1).End(xlUp) 'Nieuw boek toevoegen
                 .Offset(1) = TextBox1.Text
                 .Offset(1, 4) = TextBox2.Text
           End With
        Else
          Exit Sub
        End If
     End If
  End With

@trucker10 sorry ik had je uitleg niet gezien. anders had ik nog even gewacht

Met vr gr
Jack

11221122 · 21 okt 2010

Het is (eindelijk) gelukt. Ik wist niet dat het uitmaakte of je de volgorde van End With en End If aan moest houden.

Ik had:

Code:

End If
End With
End If

Maar het moest zijn:

Code:

End If
End If
End With

trucker10 · 21 okt 2010

@11221122 , in een ander forum heb ik als handtekening

Ervaring is de optelsom, van alle vergissingen die je hebt begaan.

:thumb:

11221122 · 21 okt 2010

Dat is waar! De beste leermethode is door iets veel te doen..

Btw. Ken jij een website waar alle/ veel formules staan beschreven. Want ik loop daarmee vaak tegen de lamp. Dat ik een heel systeem heb alleen dat het niet wil werken omdat ik niet weet hoe ik iets moet formuleren.

Mvg.

Boekenlijst in excel

Gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Meubilair

Gebruiker

Terugkerende gebruiker

Bijlagen

Meubilair

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Meubilair

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Wij waarderen jouw privacy