[anestaki]

Καλησπέρα
Τάσο σε ευχαριστώ που συνεχίζεις να με υποστηρίζεις
Ενώ δουλεύει κανονικά όπως μου είπες όταν το χρησιμοποιώ στην δική μου φόρμα δεν λειτουργεί
Και θα ήθελα να μου υπόδειξη το λάθος μου.

Option Explicit
Private rng As Range, c As Range

Private Sub UserForm_Initialize()
ComboBox1.List() = Φύλλο3.Range("AA1:AA24").Value
ComboBox1 = Φύλλο3.Range("G7").Value
TextBox1 = Φύλλο3.Range("l7").Value
TextBox2 = Φύλλο3.Range("n7").Value
TextBox2 = Format(Me.TextBox2, "dd-mm-yyyy")
TextBox3 = Φύλλο3.Range("j10").Value
TextBox4 = Φύλλο3.Range("j11").Value
TextBox5 = Φύλλο3.Range("j12").Value
TextBox6 = Φύλλο3.Range("j13").Value
TextBox7 = Φύλλο3.Range("j14").Value
TextBox8 = Φύλλο3.Range("j15").Value
TextBox9 = Φύλλο3.Range("j16").Value
TextBox10 = Φύλλο3.Range("j17").Value
ComboBox2 = Φύλλο3.Range("g15").Value
ComboBox3 = Φύλλο3.Range("g16").Value
ComboBox4 = Φύλλο3.Range("g17").Value
With Φύλλο16
If Application.CountA(Range(.Cells(2, 3), .Cells(2, 3).End(xlDown))) Then
Set rng = Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp))
FillCombo ComboBox2, rng
Else
Set rng = .Cells(1, 3)
End If
End With
ComboBox3.List = ComboBox2.List
ComboBox4.List = ComboBox2.List
ComboBox5.List = ComboBox2.List
ComboBox6.List = ComboBox2.List
ComboBox8.List = ComboBox2.List
ComboBox9.List = ComboBox2.List
ComboBox10.List = ComboBox2.List
ComboBox19.List = ComboBox2.List


End Sub
Private Sub ComboBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If Trim(ComboBox2.Text) = "" Then Exit Sub
ComboBox2.Text = Trim(ComboBox2.Text)
If KeyCode = vbKeyReturn Then
Set c = rng.Find(ComboBox2.Text, LookIn:=xlValues)
If c Is Nothing Then
If MsgBox("Η εγγραφή αυτή δεν υπάρχει στη λίστα." & " Να την καταχωρήσω;", vbQuestion + vbYesNo) = vbYes Then
Set rng = rng.Resize(rng.Rows.Count + 1, 1)
If rng.Row = 1 Then
Set rng = rng.Offset(1).Resize(1, 1)
rng.Value = ComboBox2.Text
ComboBox2.AddItem rng.Text
Else
rng(rng.Rows.Count).Value = ComboBox2.Text
FillCombo ComboBox2, rng
End If
ComboBox2.Value = rng(rng.Rows.Count).Text
End If
End If
End If
End Sub

 
Private Sub FillCombo(ByVal cbo As MSForms.ComboBox, ByVal rng As Range)
Dim c As Range, i As Long, x As Long, sw1, sw2, Itm
Dim Coll As New Collection
On Error Resume Next
For Each c In rng
Coll.Add c.Value, c.Text
Next
On Error GoTo 0
For i = 1 To Coll.Count - 1
For x = i + 1 To Coll.Count
If UCase(Coll(i)) > UCase(Coll(x)) Then
sw1 = Coll(i)
sw2 = Coll(x)
Coll.Add sw1, before:=x
Coll.Add sw2, before:=i
Coll.Remove i + 1
Coll.Remove x + 1
End If
Next x
Next i
cbo.Clear
For Each Itm In Coll
cbo.AddItem Itm
Next Itm
End Sub