+ Reply to Thread
Results 1 to 3 of 3

Dependant comboboxes and labels showing text

Hybrid View

  1. #1
    Registered User
    Join Date
    10-24-2011
    Location
    Playa del Carmen, Mexico
    MS-Off Ver
    Excel 2003
    Posts
    33

    Dependant comboboxes and labels showing text

    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 file i put together:

    Excursiones RM - 14.30.xls

    And here is the code:

    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

  2. #2
    Registered User
    Join Date
    10-24-2011
    Location
    Playa del Carmen, Mexico
    MS-Off Ver
    Excel 2003
    Posts
    33

    Re: Dependant comboboxes and labels showing text

    Any ideas?

  3. #3
    Registered User
    Join Date
    10-24-2011
    Location
    Playa del Carmen, Mexico
    MS-Off Ver
    Excel 2003
    Posts
    33

    Re: Dependant comboboxes and labels showing text

    Bump to see if someone knows.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1