Posts by Zio Frank

Zio Frank · Jun 16th 2022

Hello, I ask if anyone can help me in making the column A of "Sheet1" appear in the listbox that is started with the "Start form" button, in addition to column B.

If you can then make the search work in both columns.

This is a userform that I found on the net and tried to adapt to my needs.

Thanks to anyone who can give me a tip

Code

Option Explicit

'Variabile globale per contenere il range di celle di cui si occupa questo form
Private ColonnaInEsame As Range

Private Sub Label11_Click()
Dim dimmi As Long
If Label11.Caption = "Elimina" Then
dimmi = MsgBox("Vuoi eliminare i dati di " & textbox1.Text & " ?", vbCritical + vbYesNo, "A T T E N Z I O N E . . .")
If dimmi = vbNo Then Exit Sub
End If


Foglio1.Rows(ListBox1.ListIndex + 2).Delete
ListBox1.RemoveItem (ListBox1.ListIndex)

End Sub
Private Sub Label12_Click()
textbox1 = ""
ComboBox1 = ""
ComboBox2 = ""
ComboBox3 = ""
Textbox4 = ""
TextBox9 = ""
textbox1.SetFocus
End Sub
Private Sub Label13_Click()
'
' Copia_dati_atleta Macro
'
Sheets("Dati_esibizione").Visible = True
    Sheets("Dati_esibizione").Select
    Range("B41:B45").Select
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A47").Select
    Selection.Copy
    Range("A48").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         
    Sheets("Dati_esibizione").Visible = False
End Sub

Private Sub Label14_Click()
'
' Ord_Num Macro
'

    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add2 Key:=Range("A3:A102" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange Range("A3:F102")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Label15_Click()
'
' Ord_Nome Macro
'

    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add2 Key:=Range("B3:B102" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange Range("A3:F102")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Label16_Click()
'
' Ord_Disciplina Macro

    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add2 Key:=Range("C3:C102" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange Range("A3:F102")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Label17_Click()

End Sub

Private Sub Label19_Click()
 Me.Hide
    
    Sheets("Foglio1").Select
    ActiveWindow.SelectedSheets.PrintPreview
    Me.Show
End Sub

Private Sub Label20_Click()

End Sub

Private Sub Label21_Click()


ActiveWorkbook.Save
Unload Me
Sheets("Foglio1").Visible = False
     
Menu_iniziale.Show

End Sub

Private Sub Label3_Click()
 Application.ScreenUpdating = False
   
 Dim gia As Variant
 Dim fineri As Variant
 Dim riga As Variant
    gia = textbox1.Text  'con la variabile "gia" prendiamo il dato che ? nella textbox
    fineri = Sheets("Foglio1").[B1].End(xlDown).Row  'poi prendiamo il numero dell'ultima riga occupata in una 'colonna, iniziando dalla cella intestazione di colonna
    riga = 2  'quindi si imposta la riga da cui iniziare il ciclo Do While
        Do While Cells(riga, 1) <> ""  'il ciclo scorrer? tutte le celle occupate (diverse da vuoto)
            If Cells(riga, 1) = gia Then      'si controlla se la cella ora letta ? uguale al nome ora nella variabile "gia"
                MsgBox "Il Nome " & textbox1.Text & " è già presente in archivio", vbInformation + vbOKOnly, "Archivio Elenco colori"
                Exit Sub
                  'si posiziona il focus sulla textbox
                End If
                    riga = riga + 1   'se il nome non ? uguale si incrementa di uno l'indice di "riga"
                    Loop     'e si "gira" ritornando all'inizio ciclo per ripetere con la cella successiva, fino a quando si trover? una cella 'libera



    Cells(riga, 1) = WorksheetFunction.Max(ActiveSheet.Range("A:A")) + 1
    Cells(riga, 2) = gia
    Cells(riga, 3) = ComboBox1
    Cells(riga, 4) = ComboBox2
    Cells(riga, 5) = ComboBox3
    
    With Foglio1
        Set ColonnaInEsame = .Range(.Range("B2").Address, .Range("B1").End(xlDown).Address)
    End With
    
    textbox1.SetFocus
    PopolaListbox
    PopolaDettagli 0
   
textbox1.Text = ""
ComboBox1.Text = ""
ComboBox2.Text = ""
ComboBox3.Text = ""
Textbox4.Text = ""

Application.ScreenUpdating = False
End Sub

Private Sub textbox1_Change()

End Sub


Private Sub TextBox10_Change()

End Sub


'INIZIALIZZAZIONE
Private Sub UserForm_Initialize()

On Error Resume Next

 Dim i As Long
    Dim uriga As Long
    Dim wsh As Worksheet
    With Foglio1
        Set ColonnaInEsame = .Range(.Range("B2").Address, .Range("B1").End(xlDown).Address)
    End With
    With Me.SpinButton1
        .Min = -1
        .Max = ColonnaInEsame.Rows.Cells.Count
        .SmallChange = -1
    End With
    
    PopolaListbox
    PopolaDettagli 0
  
    Set wsh = ThisWorkbook.Worksheets("Foglio1")
    uriga = wsh.Range("B" & Rows.Count).End(xlUp).Row

    For i = 2 To uriga

        textbox1.Value.wsh.Range ("B" & i)

    Next
 
End Sub
'SPINBUTTON della listbox
Private Sub SpinButton1_Change()
    With SpinButton1
        If .Value > ListBox1.ListCount - 1 Then
            .Value = 0
        ElseIf .Value < 0 Then
            .Value = ListBox1.ListCount - 1
        End If
            ListBox1.Selected(.Value) = True
            PopolaDettagli .Value
    End With
End Sub
'LISTBOX
Private Sub ListBox1_Click()
    Dim x, xx, y, riga As Integer
    Me.SpinButton1.Value = ListBox1.ListIndex
    
    For x = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(x) Then
            xx = x + 1
            For y = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                If ActiveSheet.Cells(y, 6) = 1 Then
                    riga = y
                    xx = xx - 1
                    If xx = 0 Then Exit For
                End If
            Next y
        End If
    Next x

    textbox1 = Cells(riga, 2)
    ComboBox1 = Cells(riga, 3)
    ComboBox2 = Cells(riga, 4)
    ComboBox3 = Cells(riga, 5)
    Textbox4 = Cells(riga, 1)

End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ListBox1_Click
    
End Sub
'Casella di RICERCA
Private Sub TextBox9_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    PopolaListbox (TextBox9.Text)
End Sub
' Popolamento della listbox
Private Sub PopolaListbox(Optional ByVal Testo As String)
    ListBox1.Clear
    Dim Cella As Range
    For Each Cella In ColonnaInEsame.Cells
        If UCase(Cella.Value) Like UCase("*" & Trim(Testo) & "*") Then
            ListBox1.AddItem Cella.Value
            ActiveSheet.Cells(Cella.Row, 6).Value = 1
        Else
            ActiveSheet.Cells(Cella.Row, 6).Value = 0
        End If
    Next
    With ListBox1
        If .ListCount > 0 Then
            .Selected(0) = True
        End If
    End With
End Sub
'popolamento dei dettagli
Private Sub PopolaDettagli(ByVal IndexDellaLista As Long)
On Error Resume Next
    Dim CellaBuona As Range
    Set CellaBuona = ColonnaInEsame.Find(ListBox1.List(IndexDellaLista))
    With Me
        
       
        .textbox1 = CellaBuona.Value
        .ComboBox1 = CellaBuona.Offset(0, 1).Value
        .ComboBox2 = CellaBuona.Offset(0, 2).Value
        .ComboBox3 = CellaBuona.Offset(0, 3).Value
        .Textbox4 = CellaBuona.Offset(0, 4).Value
    End With
End Sub

Display More