Zoeken in listbox & textbox

[Speedsurfer]

Het origineel wil ik niet openbaar zetten.
Aan het start menu kan je wellicht zien dat er veel onder hangt.
Weet niet of ik hem prive mag sturen.?
Zit natuurlijk het nodige vertrouwelijke in.

Met [Msgbox Ubound(sv,2)] heb ik een echte vastloper.

 

[HSV]

Nee, geen privé berichten.
Als ik het zat ben reageer ik niet meer.

Ik heb de msgbox geplaatst voor je.

Private Sub UserForm_Initialize()
[COLOR=#ff0000]msgbox ubound(sv,2)[/COLOR]
  sv = Sheets("Klantenlijst").Cells(1).CurrentRegion.Value
  ListBox4.List = sv
  ListBox3.List = ListBox4.List
  ListBox3.ListIndex = 0
End Sub

 

[Speedsurfer]

Fout 13 tijdens uitvoering:
Typen komen niet overeen.
Krijg ik als foutmelding na het invoeren cq vervangen van deze code.
In het testbestand gaat het maar wederom in het origineel niet.

 

[HSV]

Staat er in je origineel onder 'option explicit' wel..

Dim sv

?

 

[Speedsurfer]

[Dim X, sds, say1 As Long]

 

[HSV]

Dim Yeni_mi As Boolean
Dim TbLen2 As Long
[COLOR=#ff0000]Dim sv[/COLOR]
Private Sub CommandButton1_Click()
Dim Son_Dolu_Satir, Bos_Satir As Long
Son_Dolu_Satir = Sheets("Klantenlijst").Range("A600").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Klantenlijst").Range("B" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Klantenlijst").Range("B:B")) + 1
Sheets("Klantenlijst").Range("B" & Bos_Satir).Value = TextBox20.Text 'Klant-ID
Sheets("Klantenlijst").Range("C" & Bos_Satir).Value = TextBox23.Text 'Titel
Sheets("Klantenlijst").Range("D" & Bos_Satir).Value = TextBox14.Text 'Voornaam
Sheets("Klantenlijst").Range("E" & Bos_Satir).Value = TextBox15.Text 'Achternaam
Sheets("Klantenlijst").Range("F" & Bos_Satir).Value = TextBox16.Text 'Adres
Sheets("Klantenlijst").Range("G" & Bos_Satir).Value = TextBox17.Text 'Postcode
Sheets("Klantenlijst").Range("H" & Bos_Satir).Value = TextBox21.Text 'Woonplaats
Sheets("Klantenlijst").Range("I" & Bos_Satir).Value = TextBox18.Text 'Land
Sheets("Klantenlijst").Range("K" & Bos_Satir).Value = TextBox19.Text 'Email
Sheets("Klantenlijst").Range("P" & Bos_Satir).Value = TextBox25.Text '2016
Sheets("Klantenlijst").Range("O" & Bos_Satir).Value = TextBox26.Text '2017
Sheets("Klantenlijst").Range("N" & Bos_Satir).Value = TextBox27.Text '2018
Sheets("Klantenlijst").Range("M" & Bos_Satir).Value = TextBox28.Text '2019
Sheets("Klantenlijst").Range("L" & Bos_Satir).Value = TextBox29.Text '2020
Sheets("Klantenlijst").Range("Q" & Bos_Satir).Value = TextBox24.Text 'Aankoopbedrag
Sheets("Klantenlijst").Select
ListBox3.Clear
Refresh
Label35.Caption = ListBox3.ListCount
End Sub
Private Sub Listbox3_Click() 'Aangepast door HSV
Dim Bulunan_Satir_No As Long
With ListBox3
Bulunan_Satir_No = .ListIndex + 1
TextBox14.Text = .Column(3) 'Voornaam
TextBox15.Text = .Column(4) 'Achternaam
TextBox16.Text = .Column(5) 'Adres
TextBox21.Text = .Column(7) 'Woonplaats
TextBox18.Text = .Column(8) 'Land
TextBox19.Text = .Column(10) 'Email
TextBox25.Text = .Column(15) '2016
TextBox26.Text = .Column(14) '2017
TextBox27.Text = .Column(13) '2018
TextBox28.Text = .Column(12) '2019
TextBox29.Text = .Column(11) '2020
TextBox24.Text = .Column(16) 'Aankoopbedrag
End With
Dim mycontrol As Object
For Each mycontrol In Klantenlijst.Controls
If TypeName(mycontrol) = "TextBox" Then
If IsNumeric(mycontrol.Value) Then
mycontrol.Value = Format(mycontrol.Value, "€ #,##0.00")
End If
End If
Next mycontrol
TextBox17.Text = Sheets("Klantenlijst").Range("G" & Bulunan_Satir_No).Value 'Postcode
TextBox20.Text = Sheets("Klantenlijst").Range("B" & Bulunan_Satir_No).Value 'Klant-ID
TextBox23.Text = Sheets("Klantenlijst").Range("C" & Bulunan_Satir_No).Value 'Titel
End Sub

 

[Speedsurfer]

Beste Harry.
Wat een inzet.
Geweldig.
Moet helaas zeggen dat op welke manier ik het tot dusver aanpak, geen resultaat geef.
Kleine stapjes voorwaarts en af en toe stappen terug.
Ik ga morgen alle aangedragen suggesties nog eens opnieuw in en uitvoegen.
Op dit moment moet ik echt alles eens op een rij zetten.
Ik wil je in ieder geval enorm danken voor je geduld en nogmaals inzet.
Ik hoop dat je later me nog eens wilt helpen.
Grtz Frans

 

[HSV]

Graag gedaan, en dan de andere subs maar wat reduceren.

 

[Speedsurfer]

Ha Ha, Humor.
Zal ik niet ongestraft voor elkaar krijgen.
Ter info originele bestand bestaat uit 39 Tabbladen.
Allen gekoppeld aan elkaar.
Met heel veel macro's en VBA
Was en ben er erg trots op.
Maar kijk toch elke keer weer naar verbetering.

 

[Speedsurfer]

Na een nachtje slapen en overdenkingen alwaar de fout(en) zitten, vanochtend weer de adviezen van HSV opgepakt.
Schuiven en stoeien, en vervolgens bleek het in het bereik te zitten van het aantal opgegeven kolommen.
Ben weer een stuk verder gekomen.
Nu aan de slag met het reduceren van de subs.
Was hard nodig volgens HSV
Zoals eerder gezegd:
Zal ik niet ongestraft voor elkaar krijgen.
Originele bestand bestaat uit 39 Tabbladen.
Alles gekoppeld aan elkaar.
Met veel macro's en VBA
Ben er erg trots op.
Maar kijk elke keer weer naar verbetering.
Dank voor de geboden hulp.
Grtz Speedsurfer

 

[Speedsurfer]

Wellicht kan iemand mij een tip geven waar en hoe ik deze vraag als afgehandeld kan zetten.?

 

[HSV]

In je openingsvraag.