Dependent Comboboxes and Text Labels

[Tunk Ayauit]

Hello everybody

A few months ago I was able to put together a very handy UserForm thanks to this site. Now I have the need to upgrade it and once again need your help.

All the info comes from a spreadsheet, it is a list with all the items that could be used from several suppliers, up until now I've used the UserForm for just one supplier. So I would need to make the second combobox dependant on the first combobox choice. The way the info is allocated is as a list, which means Supplier A's name is in cell A3, then from cell A4 to A25 are all their services, then Supplier B's name in cell A26, from cell A27 to A32, all of Supplier B's services and so on. I'm not sure if it can be done like that or maybe I have to create a column with the supplier names and "filter" everytime the user chooses a supplier.

The second upgrade that I need is adding two Labels in which I need to display the suppliers number and the service code, both of them dependant on the user's choices.

Can anyone help me?

Here is the code I'm currently using:

Private Sub btnCalculate_Click()Dim PrecioAdulto As Double
Dim PrecioNinio As Double
Dim PrecioTotal As Double
Dim PrecioFee As Double
Dim PrecioTotalAdultos As Double
Dim PrecioTotalNinios As Double


PrecioAdulto = 0
PrecioNinio = 0
PrecioTotal = 0
PrecioFee = 0
PrecioTotalAdultos = 0
PrecioTotalNinios = 0


If txtAdults.Value = 0 And txtChildren.Value = 0 Then
MsgBox ("Ingrese Por lo menos una persona ya sea adulto o ninio")
Exit Sub
End If




PrecioAdulto = BuscarPrecioAdulto(cboServices.Value)
PrecioNinio = BuscarPrecioNinio(cboServices.Value)
PrecioFee = ObtenerPrecioFee(cboServices.Value)
PrecioComision = ObtenerPorcentajeComision(cboServices.Value)
TotalAdultos = txtAdults.Value * 1
TotalNinios = txtChildren.Value * 1
PaxTotal = TotalAdultos + TotalNinios
PrecioTotalAdultos = txtAdults.Value * PrecioAdulto
PrecioTotalNinios = txtChildren.Value * PrecioNinio
PrecioTotal = PrecioTotalAdultos + PrecioTotalNinios
TipoDeCambio = lblTipodeCambio.Caption
PrecioTotalMXN = PrecioTotal * TipoDeCambio
Comision = PrecioTotalMXN * PrecioComision
PrecioNeto1 = PrecioTotalMXN - Comision
PrecioNeto2 = PrecioNeto1 - TotalServicio
Servicios = PaxTotal
TotalServicio = PaxTotal * PrecioFee




lblPVP.Caption = Format(PrecioTotalMXN, "currency")
lblBAseComUnit.Caption = Format((PrecioNeto1 - TotalServicio) / 1.11, "currency")
lblServicefee.Caption = Format((PaxTotal * PrecioFee), "currency")
lblMarkup.Caption = Format((Comision / 1.11), "currency")
lblNumProveedor.Caption = Text(ObtenerNumProveedor)


End Sub


Private Sub btnReservaAnticipada_Click()
Dim PrecioAdulto As Double
Dim PrecioNinio As Double
Dim PrecioTotal As Double
Dim PrecioFee As Double
Dim PrecioTotalAdultos As Double
Dim PrecioTotalNinios As Double


PrecioAdulto = 0
PrecioNinio = 0
PrecioTotal = 0
PrecioFee = 0
PrecioTotalAdultos = 0
PrecioTotalNinios = 0


If txtAdults.Value = 0 And txtChildren.Value = 0 Then
MsgBox ("Ingrese Por lo menos una persona ya sea adulto o ninio")
Exit Sub
End If


PrecioAdulto = BuscarPrecioAdulto(cboServices.Value)
PrecioNinio = BuscarPrecioNinio(cboServices.Value)
PrecioFee = ObtenerPrecioFee(cboServices.Value)
PrecioComision = ObtenerPorcentajeComision(cboServices.Value)
TotalAdultos = txtAdults.Value * 1
TotalNinios = txtChildren.Value * 1
PaxTotal = TotalAdultos + TotalNinios
PrecioTotalAdultos = txtAdults.Value * PrecioAdulto
PrecioTotalNinios = txtChildren.Value * PrecioNinio
PrecioTotal = PrecioTotalAdultos + PrecioTotalNinios
TipoDeCambio = lblTipodeCambio.Caption
PrecioTotalMXN = PrecioTotal * TipoDeCambio
Comision = PrecioTotalMXN * PrecioComision
PrecioNeto1 = PrecioTotalMXN - Comision
PrecioNeto2 = PrecioNeto1 - TotalServicio
Servicios = PaxTotal
TotalServicio = PaxTotal * PrecioFee




lblPVP.Caption = Format(PrecioTotalMXN, "currency")
lblBAseComUnit.Caption = Format((PrecioNeto1 - TotalServicio) / 1.11, "currency")
lblServicefee.Caption = Format((PaxTotal * PrecioFee), "currency")
lblMarkup.Caption = Format((Comision / 1.11), "currency")
lblNumProveedor.Caption = Text(ObtenerNumProveedor)




End Sub


Sub LimpiaContenedores()
CargaXcaret.cboServices.Value = ""
CargaXcaret.lblBAseComUnit.Caption = "$"
CargaXcaret.lblMarkup.Caption = "$"
CargaXcaret.lblPVP.Caption = "$"
CargaXcaret.lblServicefee.Caption = "$"


CargaXcaret.txtAdults.Value = 0
CargaXcaret.txtChildren.Value = 0




End Sub


Private Sub btnCerrarAplication_Click()
Application.DisplayAlerts = False
    Unload Me
Application.Workbooks("Cargas Tours Riviera Maya").Activate
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub


Private Sub cmdLimpiar_Click()


 Call LimpiaContenedores
End Sub


Private Sub UserForm_Initialize()


    lblTipodeCambio.Caption = Format(Sheets("Lista de Precios").Range("H14"), "currency")
    


Dim Celda As Range
Dim UltimaFilaPrecio As Integer
Dim Agrega As String
Application.ScreenUpdating = False
    
    UltimaFilaPrecio = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    For Each Celda In Sheets("Lista de Precios").Range("A3:A" & UltimaFilaPrecio).Cells
        If Celda <> "" Then
            Agrega = Celda
            cboServices.AddItem Celda
        Else
        End If
    Next
    
End Sub


Private Sub Workbook_Xcaret_Prices_Open()
    CargaXcaret.Show
End Sub


Private Function BuscarPrecioAdulto(ValorBuscar As String) As Double
Application.ScreenUpdating = False
Dim Celda As Range
Dim RangeFind As Range
Dim UltimaFila As Integer
Dim FilaEncontrado
UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
        For Each Celda In RangeFind
            If Celda.Value = ValorBuscar Then
                FilaEncontrado = Celda.Row
            Else
            End If
        Next Celda
    BuscarPrecioAdulto = Sheets("Lista de Precios").Cells(FilaEncontrado, 2)
Application.ScreenUpdating = True
End Function


Private Function BuscarPrecioNinio(ValorBuscar As String) As Double
Application.ScreenUpdating = False
Dim Celda As Range
Dim RangeFind As Range
Dim UltimaFila As Integer
Dim FilaEncontrado
UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
        For Each Celda In RangeFind
            If Celda.Value = ValorBuscar Then
                FilaEncontrado = Celda.Row
            Else
            End If
        Next Celda
    BuscarPrecioNinio = Sheets("Lista de Precios").Cells(FilaEncontrado, 3)
Application.ScreenUpdating = True
End Function


Private Function ObtenerPrecioFee(ValorBuscar As String) As Double
Application.ScreenUpdating = False
Dim Celda As Range
Dim RangeFind As Range
Dim UltimaFila As Integer
Dim FilaEncontrado
UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
        For Each Celda In RangeFind
            If Celda.Value = ValorBuscar Then
                FilaEncontrado = Celda.Row
            Else
            End If
        Next Celda
    ObtenerPrecioFee = Sheets("Lista de Precios").Cells(FilaEncontrado, 4)
Application.ScreenUpdating = True
End Function




Private Function ObtenerPorcentajeComision(ValorBuscar As String) As Double
Application.ScreenUpdating = False
Dim Celda As Range
Dim RangeFind As Range
Dim UltimaFila As Integer
Dim FilaEncontrado
UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
        For Each Celda In RangeFind
            If Celda.Value = ValorBuscar Then
                FilaEncontrado = Celda.Row
            Else
            End If
        Next Celda
    ObtenerPorcentajeComision = Sheets("Lista de Precios").Cells(FilaEncontrado, 5)
Application.ScreenUpdating = True
End Function


Private Function ObtenerNumProveedor(ValorBuscar As String) As Double
Application.ScreenUpdating = False
Dim Celda As Range
Dim RangeFind As Range
Dim UltimaFila As Integer
Dim FilaEncontrado
UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
    Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
        For Each Celda In RangeFind
            If Celda.Value = ValorBuscar Then
                FilaEncontrado = Celda.Row
            Else
            End If
        Next Celda
    ObtenerPorcentajeComision = Sheets("Lista de Precios").Cells(FilaEncontrado, 5)
Application.ScreenUpdating = True
End Function


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
MsgBox "Use el boton cerrar del formulario", vbInformation, "Imposible Cerrar"
Cancel = 1
CloseMode = 1
End If
End Sub


Private Sub btnDias_Click()
    DiasdeOperacion.Show
End Sub


Private Sub btnBono_Click()
    Bono.Show
End Sub


Private Sub btnFAQ_Click()
    FAQs.Show
End Sub

I hope I was clear enough and appreciate in advance your help.

Tunk

 

[silkfire]

You can achieve this with named lists and formulas, no need for VBA.

 

[Tunk Ayauit]

You can achieve this with named lists and formulas, no need for VBA.

Would I need to alter the already written code? Can you elaborate a little?, I'm a seasoned noob when it comes to VBA and advanced formulas.

Thx

 

[Tunk Ayauit]

Any ideas?