Wegschrijven naar werkblad op alfabet en zoeken

[adile]

Goedenavond,

Ik heb een bestandje, waarin een database van personen (Achternaam, Voornaam, Bedrijf en Datum) moet komen met tabbladen A t/m Z.
Ik heb een invoerformulier waarin ik de gegevens invoer, na opslaan wil ik dat deze op achternaam in de juister sheet wordt gezet.
dus achternaam Aken moet bij in sheet met de naam A en achternaam bakker bij de B.

in de de sheet moet de naam die dan ingevoerd wordt ook gesorteerd worden op alfabet, eerst op achternaam kolom A en dan op voornaam kolom B.

tevens heb ik een formulier gemaakt waarin ik de gegevens wil op kunnen roepen.
dus wanneer ik de naam Bakker invul, dan moeten alle personen die de achternaam bakker hebben in een window in het formulier komen te staan.
ook wil ik kunnen zoeken op bedrijfsnaam en op datum.

Is er iemand die mij op weg kan helpen.

uitgekleed bestandje met fictieve namen bijgevoegd.

Gr Adile

 

[HSV]

Dit is het invoer gedeelte.
Namen die waarvan nog geen blad voor is wordt automatisch aangemaakt.
De rest van de code heb ik zo maar gelaten, maar "Me" is niet nodig in de code en mag je gerust verwijderen.

Private Sub CommandButton1_Click()
'check for a Name number
If Trim(Me.TextBox1.Value) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.TextBox2.Value) = "" Then
  Me.TextBox2.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.TextBox3.Value) = "" Then
  Me.TextBox3.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.ComboBox1.Value) = "" Then
  Me.ComboBox1.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
[COLOR=#ff0000]If IsError(Evaluate("'" & Left(TextBox1.Value, 1) & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = UCase(Left(TextBox1.Value, 1))
  Sheets(Left(TextBox1.Value, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ComboBox1.Value)[/COLOR]
[COLOR=#ff0000]MsgBox "Informatie ingevoerd", vbOKOnly + vbInformation, "Informatie ingevoerd"[/COLOR]
[COLOR=#ff0000]'clear the data
Unload Invoeren
ThisWorkbook.Save[/COLOR]
End Sub

Edit: Als er verder niemand reageert zal ik er morgen nog wat tijd proberen in te stoppen, maar genoeg voor vandaag.

 

[adile]

Harry,

Helemaal goed, hij zet de gegevens in het juiste werkblad. top!
nu probeer ik hem zo aan te passen dat hij ook sorteert, kan ik iets aan het stukje in het rood veranderen dat hij de actieve sheet op de juiste manier sorteert,
eerst kolom a dan b dan c?

Adile

Private Sub CommandButton1_Click()
'check for a Name number
If Trim(Me.TextBox1.Value) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.TextBox2.Value) = "" Then
  Me.TextBox2.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.TextBox3.Value) = "" Then
  Me.TextBox3.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If Trim(Me.ComboBox1.Value) = "" Then
  Me.ComboBox1.SetFocus
  MsgBox "Onvolledig ingevuld!"
  Exit Sub
End If
If IsError(Evaluate("'" & Left(TextBox1.Value, 1) & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = UCase(Left(TextBox1.Value, 1))
  Sheets(Left(TextBox1.Value, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, ComboBox1.Value)
MsgBox "Informatie ingevoerd", vbOKOnly + vbInformation, "Informatie ingevoerd"
'clear the data


  [COLOR="#FF0000"]Application.Calculation = False
    With Sheets("A")
      For i = 1 To 4
        .[A:D].Sort key1:=.Columns(i), Order1:=xlAscending
      Next
    End With
  Application.Calculation = True
[/COLOR]

Unload Invoeren
ThisWorkbook.Save
End Sub

 

[adile]

Harry,

Ik heb verder gezocht en heb er dit op gevonden,

door dit in de achter de sheets te plakken sorteert hij ook goed.

Private Sub Worksheet_Change(ByVal Target As Range)

    Range("A3:D10000").Sort [C3]
    Application.EnableEvents = True

    Range("A3:D10000").Sort [B3]
    Application.EnableEvents = True

    Range("A3:D10000").Sort [A3]
    Application.EnableEvents = True


End Sub

Nou hoop ik dat er iemand is die me met de rest van het bestand kan helpen.

gr adil

 

[Warme bakkertje]

Zoeken op naam is aangepast. Vul de naam in het tekstvak Naam in en druk op Enter of Tab.
Heb ook je Invoeren formulier aangepast met sorteren tabbladen als er een nieuw aangemaakt wordt, alsook sorteren van de namen bij het invoeren van een nieuwe naam.
De aanpassing voor zoeken op Bedrijf of Datum moet je nog even op wachten (werk roept) omdat deze over alle werkbladen zal moeten zoeken en niet alleen op 1 tabblad zoals bij het zoeken naar een naam.

 

[HSV]

De call "sortsheets" komt niet aan beurt na de msgbox Rudi.
Voor de msgbox wel.
Sorteercode iets aangepast + cdate(combobox).

 

[adile]

Rudi en Harry,

Erg bedankt voor jullie input, ben ik zeer blij mee.

de invoerknop doet precies wat ik wil nu

alleen met de zoekknop heb ik nog wat issues. Ik kan nu data zoeken met textbox1, maar ik wil dat dat ook kan op voornaam bedrijf en datum.
en is het mogenlijk om een combinatie te hebben? bv in textbox1 type ik alleen a en in textbox2 alleen de g,
dat zou me dan iedereen opleveren waarvan de voornaam met een g begint en de achternaam met een a.

oh en tevens krijg ik een error wanneer ik in textbox a iets intik, dit verwijder en dan op laden klik.

heb het bestand weer iets aangepast en bijgevoegd.

Gr Adile

 

[Warme bakkertje]

Het plaatsen van de namen in aparte sheets bemoeilijkt alles enorm, zeker nu jij uitgebreidere eisen begint te stellen aan het opzoeken.
Aangezien je toch alle resultaten wil zien in een listbox op een userform heeft het opslaan v/d namen op verschillende sheets helemaal geen zin meer.
Zet alles in één tabel en alle opzoekingen die je wil uitvoeren zullen 100X makkelijker uit te voeren zijn, anders zal je je moeten beroepen op tientallen rijen code en opbouwen van arrays om alles bij elkaar te krijgen.
Wil je om één of andere reden toch alles apart houden zou ik toch 1 verzamelsheet maken (eventueel verborgen) om alle opzoekwerk op uit te voeren.

 

[adile]

Rudi
Ik probeerde al een verzamelsheet te maken, maar ik kreeg niet alles netjes onder elkaar en hij werd niet live geupdate. Maar die losse sheets moet ik wel houden.

Adile

 

[VenA]

Ik sluit mij aan bij Warme bakkertje. Zet de gegevens in één tabel. Je kan de gegevens wel verzamelen in of een array of een een temp blad zie o.a. http://www.helpmij.nl/forum/showthread.php/876307-Listbox-tabladen?p=5642481#post5642481

Zonder iets met het formulier gedaan te hebben (is niet mijn ding en zal herschreven moeten worden) heb ik wel wat aanpassingen in het bestand gedaan.
- De gegevens van de tabjes A t/m Z in één tabel gezet in de tab 'data' middels

Sub VenA()
With Sheets("Data")
    For Each Sh In Sheets
        If Len(Sh.Name) = 1 Then
            ar = Sh.Cells(1).SpecialCells(2).CurrentRegion.Offset(1)
            .Cells(Columns(1).SpecialCells(2).Count + 1, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
        End If
    Next Sh
End With
End Sub

-In de tab 'data' een change event gemaakt die de data filtert als je in F1 wat wijzigt. (eigenlijk heb je hierdoor de verschillende tabje al niet meer nodig)

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$1" Then Sheets("data").ListObjects("Tabel1").Range.AutoFilter 1, "=" & [F1] & "*"
End Sub

-Om de, in mijn ogen overbodige tabjes, van de juiste data te voorzien een ander event aagemaakt

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.ScreenUpdating = False
If Len(Sh.Name) = 1 Then
    Cells(1).CurrentRegion.Rows.Delete
    With Sheets("data")
        .ListObjects("Tabel1").Range.AutoFilter 1, "=" & ActiveSheet.Name & "*"
        .Cells(1).CurrentRegion.Copy [A1]
    End With
End If
End Sub

Alles kan dus prima vanuit één tabel geregeld worden en scheelt heel veel code.

 

[adile]

V en A,

Hartelijk dank voor je input, ben blij dat je er ook aandacht aan wilt besteden.
hoe meer zielen des te meer kennis zou ik zeggen. bedankt.

-Ik begrijp dus dat jouw codes de informatie uit de tabbladen verzamelen in de tab data.

-deze dat wordt gefilterd als ik in F1 iets wijzig.
Waar wordt deze data op gefilterd?
Wat zou ik in F1 moeten wijzigen en waarom?

-nieuwe ingevoerde informatie zou dus ook naar tab data moeten gaan, waarna deze weer gekopieerd wordt naar de juiste tab.
hieruit begrijp ik dat de invoercode van Harry en Rudi gewijzigd moet worden?
momenteel als ik iets in de tabs invoer, via het formulier of handmatig in de sheet dan verdwijnt deze informatie weer en ik weet niet waar het naar toe gaat.

-klopt het dat de tabbladen ook automatisch op naam worden gesorteerd, want de tabjes verspringen als ik ze verplaats. tab data gaat automatisch achter tab D staan en tab gegevens achter tab G.

Dit waren wat eerste vraagjes na het uitproberen van jouw aangepaste bestandje.

Gr Adile

 

[Warme bakkertje]

Zonder veel te wijzigen aan het beginconcept.
Zoeken doe je door in de respectievelijke textboxen een naam in te typen zodat de gefilterde resultaten in de listbox komen.

 

[adile]

Rudi,

Volgens mij ben ik met deze code een heel eind op weg,
ik ben nog even bezig om de juiste code toe te passen om automatisch de summary lijst te verkrijgen.
de code van V&A geeft bij mij veel foutmeldingen.

Is het misschien handig dat ipv een nieuw werkblad te creëren, alle info naar de listbox gaat en dan dmv jouw code wordt gefilterd in de listbox?

Gr Adile

 

[Warme bakkertje]

Dat samenvoegblad heb je nodig want daar draait de filter voor de listbox op.
Het enige wat je moet doen in je origineel bestand is alle namen van alle bladen samenvoegen, zien dat alle namen in de code overeenkomen (bladnaam, tabelnaam).
Ik heb de code nu zo aangepast dat elke nieuwe naam automatisch zowel apart als in het verzamelblad geschreven wordt.
Kijk gewoon goed hoe het voorbeeldbestand in elkaar steekt en pas dit dan in in je origineel.

 

[adile]

Rudi,

Ik heb het Summary blad eindelijk voor elkaar. Dwz dat ik nu 12000 namen erin heb staan in 12000 rijen.
Als ik de letter invoer om te zoeken loopt het formulier vast omdat hij bij de eerste invoer al begint te zoeken.
als ik een A intik dan zoekt hij naar alle gegevens die een A bevatten van de 12000 en heb ik geen gelegenheid meer om een andere letter in te voeren.
is het mogelijk dat ik de letters in de betreffende textbox invoer en dat hij pas gaat zoeken als ik op zoek klik?
Ik denk dat hij dan minder snel vast zal gaan lopen.

Adile

 

[adile]

Goedenavond,

Ik voeg het bestand bij wat ik tot nu toe heb (ik ben er bijna).
Ik heb nu alleen nog een probleem met het zoeken van de personen, omdat ik dus 12000 mensen in mijn
database heb staan loopt het bestand vast als ik direct zoek met de in de tekstboxen ingevulde informatie.

Nu hoop ik dat het bestand niet vastloopt wanneer ik de textbox invul en dan op zoeken druk.
is er een manier om de code van het zoekformulier zo om te bouwen dat hij dat op die manier doet?

Alvast bedankt.

Adile

 

[Warme bakkertje]

Deze zou het beter moeten doen. Zorg er wel voor dat alle ingevulde data met een hoofdletter begint.

 

[adile]

Yep,

hij werkt veeel sneller, en een hoofdletter versnelt de boel ook stukken.

Dan heb ik echt de aller laatste vraag. in het voorbeeldbestand doet hij het wel, maar in mijn originele bestand doet de scrollbar van de listbox het niet.
dus wanneer ik bakker in tik en ik heb 60 bakkers dan kan ik niet door de namen scrollen met de scrollbar die er dan wel is.
moet ik die op de een of andere manier activeren?
In het voorbeeldbestand doet hij het ook uit zichzelf.

Adile

 

[Warme bakkertje]

Private Sub ListFill2(x)
    Dim endarr()
    If Me("TextBox" & x).Text = vbNullString Then ListBox1.Clear: Exit Sub
    ListEndRow = 1
    With Sheets("Summary")
        sn = .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
        lrows = .ListObjects(1).DataBodyRange.Rows.Count
        ReDim endarr(1 To lrows, 1 To 4)
        For i = 1 To UBound(sn)
            If Left(sn(i, x), Len(Me("TextBox" & x).Text)) = StrConv(Me("TextBox" & x).Text, 3) Then
                For J = 1 To 4
                    endarr(ListEndRow, J) = sn(i, J)
                Next
                ListEndRow = ListEndRow + 1
            End If
        Next
    End With
    ListBox1.List = endarr
End Sub

Deze zou nog sneller moeten zijn.
Voor de listbox kijk eens bij de eigenschappen v/d listbox naar Locked deze moet op False staan.

 

[adile]

van je laatste code krijg ik volgende error in mijn originele bestand.

subscribt valt buiten bereik.
onderstaande regel wordt geel.

  lrows = .ListObjects(1).DataBodyRange.Rows.Count

In de eigenschappen van mijn listbox staat locked op false

Adile