Alonso Ojeda

Gracias @bigpetroman, Si me es funcional👍

Buenas, tengo un archivo que lo estoy utilizando para llevar el control de los permisos vigentes de los organismo públicos etc. , la columna A tengo los entes publicos, en la columna B la descripcion de los permisos y las columnas siguientes los calculos del tiempo de vigencia, en la Columna N= tengo formulas que colocan según los tiempos vigente=Activo, Renovación=según el periodo que se necesite para renovarlo. y Vencido si la renovación tarda mas de lo normal. Tengo un formulario de advertencia que lo que quiero hacer es que al activar la hoja, me evalue la columna N (Vigente, Renovación ó Vencido), y según estas me coloque en el label1= La Descripción de la Columna B (Perimisos) y en el label2= La Palabra Renovación o vencido según la celda de esa palabra y me recorra la columna N mostrando más permisos, ahora si todos los permisos estan vigente que se cierre el Formulario. Permisolog.xlsm

Si, esto es lo que quería, muchísima gracias

Ya Lo adjunte, mucho sabría agradecer, gracias

Reprodxlsm.xlsm

Buenas, tengo una base de datos con 4 columnas que utilizo para reproducir música, la columna A=están los cantantes, en B= las canciones, en C=Los géneros y D=la dirección de la canción. realice un formulario con dos combobox dependiente, en el primero la lista es de la Columna C=(Géneros), al abrir escojo el genero y el 2do. me Trae la Columma A=Los Cantantes, una vez seleccionado el cantante en el listbox se me descarga todas las canciones de este. y selecciono y empieza a sonar. En el 1er. combobox el me trae los valores sin repetidos, pero no consigo un código que el 2do. haga lo mismo. este es el código que utilizo: Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Const WS_MINIMIZEBOX As Long = &H20000 Private Const WS_MAXIMIZEBOX As Long = &H10000 Private Const GWL_STYLE As Long = (-16) Public dir Private Sub CboGen_Change() Dim fila As Integer Dim uf As Integer Dim d1, d2 As String fila = 5 uf = RegMu.Range("A" & Rows.Count).End(xlUp).Row CboArt.Clear While RegMu.Cells(fila, 3) <> Empty d1 = CboGen d2 = RegMu.Cells(fila, 3) If d1 = d2 Then CboArt.AddItem RegMu.Cells(fila, 1) End If fila = fila + 1 Wend End Sub Private Sub CboArt_Change() Application.ScreenUpdating = False Dim fila, a As Integer Dim dato, var As String ListCanc.Clear ListCanc.ColumnCount = 1 a = 0 fila = 5 While RegMu.Cells(fila, 1) <> Empty dato = CboArt var = RegMu.Cells(fila, 1) If var = dato Then dir = RegMu.Cells(fila, 1).Address(False, False) a = ListCanc.ListCount ListCanc.AddItem ListCanc.List(a, 0) = RegMu.Cells(fila, 2) End If fila = fila + 1 Wend Application.ScreenUpdating = True End Sub Private Sub ListCanc_Click() Dim Cuenta As Integer Dim Rango As Range Dim I As Integer Dim Valor As String Dim fila As Integer RegMu.Select Range("A6").Activate Cuenta = Me.ListCanc.ListCount fila = 6 Set Rango = Range("A6").CurrentRegion For I = 0 To Cuenta - 1 If Me.ListCanc.Selected(I) Then Valor = Me.ListCanc.List(I) Rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate ActiveCell.Offset(0, 2).Select End If Next I FrmRegMus.WindowsMediaPlayer1.URL = ActiveCell.Value End Sub Private Sub UserForm_Activate() Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long If Application.Version < 9 Then lngMyHandle = FindWindow("THUNDERXFRAME", Me.Caption) Else lngMyHandle = FindWindow("THUNDERDFRAME", Me.Caption) End If lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE) lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle End Sub Private Sub UserForm_Initialize() Dim sd As New Collection Dim celda As Range Dim dato As String Dim r As String Dim uf As Integer Application.ScreenUpdating = False On Error Resume Next CboGen.Clear RegMu.Select Range("C6").Select uf = Range("C" & Rows.Count).End(xlUp).Row r = "C6:C" & uf For Each celda In Range(r) sd.Add celda.Value, CStr(celda.Value) Next celda For Each dato In sd CboGen.AddItem dato Next dato Application.ScreenUpdating = True End Sub