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
Bookmarks