Reducción de valores mostrados en lista desplegable con criterio de búsqueda

Como ya hemos mostrado en este blog, hay muchas formas de crear listas desplegables en Excel:

• con Validación de Datos, Lista;
• incrustando en la hoja un cuadro combinado (combobox) o un cuadro de lista (listbox) de la colección de formularios;
• programando un cuadro combinado o un cuadro de lista en un Userform en el editor de Vba (macros).

Todas las técnicas pueden verse en mi e-book "Listas Desplegables - la guía JLD".

Uno de los requerimientos de los usuarios es la posibilidad de reducir los valores que aparecen en la lista de acuerdo a algún criterio. Supongamos que tenemos una lista de varios cientos de productos y queremos ver sólo aquellos que contengan la palabra "aceite" antes de seleccionar los valores deseados.

En este post voy a mostrar cómo hacerlo usando un ListBox para crear la lista desplegable y un cuadro de texto para introducir el texto del criterio de búsqueda. Todo ésto lo armamos en un Userform y, por supuesto, usaremos código de Vb para activar el modelo.

Esta captura de pantalla  muestra como funciona nuestro modelo. Cada vez que ingresamos un valor en la casilla de textos, la lista desplegable se reduce a los valores que contienen ese texto

El origen de los datos de la lista desplegable es una lista de precios que se encuentra en una tabla que llamaremos "tbl_Productos"

No me voy a extender aquí sobre las bondades de usar Tablas para organizar nuestros datos en las hojas de Excel, tema que he tocado varias veces en este blog.

Creamos un Userform con un cuadro de lista (Listbox), un cuadro de texto (Textbox) y dos botones de comando

Cuando incrustamos el cuadro de lista (Listbox) en el formulario, definimos ciertas propiedades en la ventana de propiedades

Como puede apreciarse RowSource (la fuente de los datos de la lista) se refiere directamente a la tabla con su nombre.
Para facilitar el código que mostramos más adelante, creamos también un nombre definido que se refiere a la tabla

Los códigos detrás de los objetos (que van en el módulo del Userform) son los siguientes:

# - un evento Change para el ListBox. Este evento se dispara cada vez que tecleamos algún valor en la casilla de texto; cuando esta vacía vemos todos los valores de la lista de precios

 Private Sub tboxCriterio_Change()  
   Dim v As Variant, i As Long  
   v = Range("lstProductos").Value  
   With Me.lbxProductos  
   If Len(Me.tboxCriterio.Value) = 0 Then  
     .RowSource = "lstProductos"  
   Else  
     .RowSource = ""  
     For i = LBound(v, 1) To UBound(v, 1)  
       If LCase(v(i, 1)) Like "*" & LCase(tboxCriterio.Value) & "*" Then  
         .AddItem v(i, 1)  
         .List(.ListCount - 1, 1) = v(i, 2)  
       End If  
     Next i  
   End If  
   End With  
 End Sub  

# - un evento Click para el botón Cancelar

 Private Sub cbtCancelar_Click()  
   Unload ufProductos  
 End Sub  

Si estuviéramos usando este formulario en un modelo real tendríamos que escribir código para el botón Aceptar. Aquí estamos mostrando solamente cómo crear la lista desplegable así que dejaremos ese código para algún post en el futuro (en caso que algunos de mis lectores quieran ver como aplicar esta técnica a un ejemplo).

Para activar el Userform usamos el botón "Lista de productos" al cua tiene asociado este código

 Sub listaProductos()  
   ufProductos.Show  
 End Sub  

Nuevo catálogo de imágenes con Excel

Han pasado casi siete años desde que publiqué el último post sobre el tema de catálogos de imágenes con Excel. Este tema se encuentra entre los más leídos por mis lectores (aunque debo señalar que no recomiendo crear este tipo de aplicaciones con Excel).

En el post mencionado uso Vba (macros) para incrustar las imágenes guardadas en una carpeta en la hoja. La técnica consiste en guardar las direcciones de las imágenes en una tabla de Excel. En otra hoja el usuario introduce un texto que hace referencia a la dirección de la imagen y de esta manera, con el código, introducimos la imagen en la hoja de Excel. Esto tiene muchas ventajas pero presenta la dificultad de tener que actualizar la lista de referencia-dirección de la imagen.

Usando Power Query podemos crear una consulta que mantenga actualizada la lista de direcciones, en lugar de tener que usar todo tipo de códigos complicados.
Supongamos que queremos construir un modelo donde al ingresar el usuario el nombre de un país en la celda contigua aparece la bandera del país elegido. En nuestro ejemplo tenemos todos los archivos de las imágenes de las banderas en la carpeta “Banderas”

El proceso lo muestro en este video

Una vez creada la conexión, solo tenemos que apretar el botón Actualizar para mantener la tabla de referencias actualizada

El próximo paso es crear el nombre definido "rngPaisDireccion" que se refiere a la tabla completa, sin los encabezados

En otra hoja creamos esta tabla, con los encabezados y una fila vacía

Creamos un nombre definido que se refiere a todas las celdas de la columna Pais ("PicList"), que luego usaremos en el código

Como ven, ya hemos agregado dos botones para activar las macros. Una para insertar las banderas correspondientes a los nombres de los países que ingresemos en la columna A y otro para remover los países que ingresamos y las imágenes de sus banderas.

El código para insertar las banderas es

 Sub insert_pic()  
   Dim strFileName As String  
   Dim iTop As Integer  
   Dim rngCellPic As Range  
   'comprobar que se introdujeron paises  
   If WorksheetFunction.CountA(Range("PicList")) < 1 Then  
     MsgBox "No se anotaron paises", vbCritical  
     Exit Sub  
   End If  
   Application.ScreenUpdating = False  
   For Each rngCellPic In Range("PicList")  
   'defiinir alto de fila a 60 y centrar  
   With rngCellPic  
     .RowHeight = 60  
     .VerticalAlignment = xlCenter  
   End With  
   'introducir la bandera  
   strFileName = WorksheetFunction.VLookup(rngCellPic, Range("rngPaisDireccion"), 2, 0)  
   ActiveSheet.Shapes.AddPicture Filename:=strFileName, _  
       linktofile:=msoFalse, _  
       savewithdocument:=msoCTrue, _  
       Left:=rngCellPic.Offset(0, 1).Left + 15, _  
       Top:=rngCellPic.Offset(0, 1).Top + 5, _  
       Width:=50, Height:=50  
   Next rngCellPic  
   Application.ScreenUpdating = True  
 End Sub  

El código para limpiar todas las filas de la tabla es el siguiente

 Sub clean_all()  
   Dim rngCell As Range  
   Dim shpImage As Shape  
   Application.ScreenUpdating = False  
   'delete pictures  
   For Each shpImage In shList.Shapes  
     If shpImage.AlternativeText <> "NoDelete" Then shpImage.Delete  
   Next shpImage  
   For Each rngCell In Range("PicLIst")  
     rngCell.RowHeight = 14.25  
   Next rngCell  
   On Error Resume Next  
   Range("PicList").EntireRow.Delete  
   On Error GoTo 0  
   Application.ScreenUpdating = True  
 End Sub  

El modelo en funcionamiento

El curioso caso de las tablas dinámicas que no se actualizan.

A las disculpas presentadas en el postanterior corresponde también alguna explicación. En los últimos meses he estado desarrollando modelos con las (no tan) nuevas herramientas de Excel, Power Query y PowerPivot, lo cual consumió el poco tiempo libre que puedo dedicarle al blog.

Para quien haya trabajado exclusivamente con Excel el aprendizaje de estas nuevas herramientas presupone un esfuerzo adicional: dejar de “pensar Excel”. Además cada una de estas aplicaciones viene con sus propios lenguajes (“M” para Power Query; “DAX” para PowerPivot) y sus propias funciones. Pero, el tema de este post no es “Introducción a Power Query…” o “Como PowerPivot cambió mi vida”, sino compartir un aprendizaje relacionado con Power Query.

Hace unos días finalicé el desarrollo de un modelo para controlar lotes en una empresa farmacéutica. La herramienta ideal era PowerPivot pero por motivos que no detallaré aquí, decidí hacer todo el desarrollo con Power Query. El modelo recibe datos, parte de ellos en forma manual; consultas en Power Query realizan las transformaciones necesarias, combinan y unen datos de distintas consultas y crean una serie de tablas planas que alimentan varios reportes creados con tablas dinámicas.

Mi intención era que el usuario apretará el botón “Actualizar todo” para asegurar que los reportes reflejaran siempre los últimos datos. Pero prudentemente desconfiando de mis usuarios, decidí incluir un evento que disparara una rutina ThisWorkbook.RefreshAll cada vez que el usuario accediera a la hoja de los reportes. Para mi desconcierto, si bien las tablas de datos se actualizaban, no así las tablas dinámicas.

Ahorrándoles la vía crucis de descubrir dónde estaba el problema, voy directamente al grano. El problema pasa por la actualización en segundo plano de las consultas (background refresh), que por definición está habilitado para toda conexión que creamos

Para permitir que todas las consultas se actualicen antes que las tablas dinámicas debemos deshabilitar la actualización en segundo plano. Una posibilidad es hacerlo manualmente, pero más eficiente es hacerlo con esta macro y al mismo tiempo actualizar todas las consultas y las tablas dinámicas

 Sub Refresh_All()  
   Dim iConnectionsCount As Integer, iX As Integer  
   iConnectionsCount = ThisWorkbook.Connections.Count  
   For iX = 1 To iConnectionsCount  
     ThisWorkbook.Connections(iX).OLEDBConnection.BackgroundQuery = False  
   Next iX  
   ActiveWorkbook.RefreshAll  
   For iX = 1 To iConnectionsCount  
     ThisWorkbook.Connections(iX).OLEDBConnection.BackgroundQuery = True  
   Next iX  
 End Sub  

La primer parte de la macro deshabilita la actualización en segundo plano de todas las conexiones. Luego realiza la actualización (Refresh.All) y finalmente rehabilita la actualización en segunda plano.

Reemplazar nombres en formulas de Excel por sus referencias.

Hace varios meses que no publico notas en el blog, no por pereza (bueno, tal vez un poco) ni por desidia y espero que mis pocos, pero leales, seguidores sepan disculparme.

Para retomar el diálogo empiezo con una solución a una consulta que suelo recibir cada tanto: ¿cómo reemplazar los nombres definidos por sus referencias? Como sabemos, los nombres definidos nos permiten, entro otras cosas, volver más legibles nuestras fórmulas (aquí pueden ver todos los posts en mi blog sobre el tema).

Por ejemplo, si en lugar de =SUMA(A2:A13) usamos =SUMA(ventas), quedará inmediatamente claro qué está calculando la fórmula.

En esta nota del 2014 mostré como Excel nos permite reemplazar las referencias en las fórmulas por nombres definidos. Pero Excel no incluye ninguna herramienta para hacer lo opuesto, es decir, reemplazar los nombres definidos en las fórmulas por sus referencias.

Si por algún motivo queremos reemplazar nombres por referencias a rangos, tendremos que echar mano a una macro.

Este código reemplazará los nombres por los rangos referidos en las celdas seleccionadas.

 Sub change_to_ref()  
   Dim Nme As Name  
   Dim rngCell As Range  
   For Each Nme In Names  
   For Each rngCell In Selection  
     If rngCell.HasFormula Then  
       If InStr(1, rngCell.Formula, Nme.Name, vbTextCompare) > 0 Then  
         rngCell.Formula = Replace(rngCell.Formula, Nme.Name, Mid(Nme.RefersTo, 2, 9999))  
       End If  
     End If  
   Next rngCell  
   Next Nme  
 End Sub  

Para usarlo lo copiamos a un módulo común en el editor de Vb, preferentemente en el cuaderno Personal.xlsb de manera que podamos utilizarlo en todos los cuadernos activos de Excel.

La función UNIRCADENAS en versiones anteriores a Excel 365

Una de las novedades en Excel 365 (2016) es la función UNIRCADENAS(), como ya mencioné en esta nota. Esta función es muy útil cuando queremos unir los valores de distintas celdas en un único valor textual. En las versiones anteriores de Excel podíamos hacerlo usando el operador "&" (que en inglés se llama ampersand y en castellano "et.") o la función CONCATENAR().
En ambos casos, cuando queremos unir valores de varias celdas, se trata de una tarea tediosa, en particular cuando queremos usar un separador entre los textos.
UNIRCADENAS() permite definir el separador e ingresar un rango de celdas lo cual facilita enórmemente la tarea. El problema es que esta función está disponible sólo para los usuarios de Excel 365 (creo que hasta hoy Microsoft no ha actualizado la versión stand-alone de Excel 2016).
La solución para los usuarios de versiones anteriores es programar un función definida por el usuario (UDF) o una macro.
La ventaja de la función UDF es que se actualizará automáticamente con cada cambio en alguna de las celdas del rango; la desventaja es que puede afectar la velocidad de recálculo del cuaderno, en particular si usamos muchas de estas funciones.
La ventaja de la macro es que no afectará la velocidad de recálculo del cuaderno, pero tendremos que activarla cada vez que efectuemos un cambio en los valores del rango.

Publico aquí ambos códigos que sugiero guardar en el cuaderno PERSONAL de manera que puedan ser usados en cualquier cuaderno.

Función UDF Unir_Cadenas

Function Unir_Cadenas(varSep As Variant, rngVals As Range)
    Dim strTemp As String
    Dim rngCell As Range
  
    For Each rngCell In rngVals
        strTemp = strTemp & rngCell & varSep
    Next rngCell
  
    Unir_Cadenas = Mid(strTemp, 1, Len(strTemp) - 1)
  
End Function

Una vez guardado el código usamos el asistente de fórmulas para activar la función

Y definimos el separador y el rango de celdas que contiene los valores a unir

Si queremos un espacio como separador, pondremos " " (espacio encerrado entre dos comillas); si no queremos ningún separador usaremos "" (dos comillas).

Macro concatenatar_rango

Sub concatenatar_rango()
    Dim strTemp As String
    Dim rngVals As Range, rngCell As Range
    Dim varSep As Variant
    Dim rngDest As Range
  
    On Error GoTo errCancel
  
    Set rngVals = Application.InputBox("Seleccione el rango de celdas a unir", "Rango a unir", Type:=8)
    varSep = Application.InputBox("Entre el separador", "Separador", Type:=2)
    Set rngDest = Application.InputBox("Seleccione la celda de destino", "Destino", Type:=8)
  
    For Each rngCell In rngVals
        strTemp = strTemp & rngCell & varSep
    Next rngCell
  
    rngDest = Mid(strTemp, 1, Len(strTemp) - 1)
  
    Exit Sub
  
errCancel:
Exit Sub
  
End Sub

Al activar la macro debemos seleccionar el rango de celdas, el separador y finalmente la celda de destino, como puede verse en este video

De matriz a columna o fila con Vba (macros)

En el post anterior vimos como Power Query nos permite convertir una matriz de varias columnas a una única columna de valores.

La nota surgió de una consulta sobre como convertir una matriz de datos (un rango de Excel con varias filas y varias columnas) a un rango de una única columna. Mi lector pedía que mostrara como hacerlo con macros. En su lugar mostré como hacerlo con Power Query y ésto por dos motivos:

1. porque estoy maravillado con las posibilidades del Power Query;
2. porque es mucho más fácil aprender a usar el Power Query que aprender Vba.

Sin embargo mi lector insistía en que la tarea debía hacerse con macros. A continuación publico el código para hacer la tarea. Al activar la macro debemos seleccionar el rango de la tabla a convertir; luego la primer celda de la columna o fila y finalmente elegir si queremos transformar la tabla en fila o columna únicas.

Este video muestra el proceso

El cuaderno con los códigos (del Userform y del módulo de Vba) puede descargarse aquí.

El modelo consta de un Userform

con sus códigos

y la procedura en el módulo común

Sub table_to_column_or_row()
    Dim rngTable As Range, rngCell As Range
    Dim rngDest As Range
    Dim intIndexCount As Integer, iX As Integer
    Dim valArray()
    Dim intOption As Integer
   
   
    On Error GoTo errCancel
    Set rngTable = Application.InputBox("Seleccione el rango de la tabla", "De tabla a columna", Type:=8)
    Set rngDest = Application.InputBox("Seleccione celda de destino", "Destino", Type:=8)
    On Error GoTo 0
   
    intIndexCount = rngTable.Count
   
    ReDim valArray(intIndexCount)
   
    For iX = 1 To intIndexCount
        valArray(iX - 1) = rngTable(iX)
    Next iX
   
   
   
    ufOptions.Show
   
    With ufOptions
        If .opbColumna Then intOption = 1
        If .opbFila Then intOption = 2
    End With
    Unload ufOptions
   
   
    Application.ScreenUpdating = False
   
    Select Case intOption
        Case Is = 1
            Set rngDest = rngDest.Resize(UBound(valArray), 1)
            rngDest = Application.Transpose(valArray)
        Case Is = 2
            Set rngDest = rngDest.Resize(1, UBound(valArray))
            rngDest = valArray
    End Select
      
    Application.ScreenUpdating = True
   
    Exit Sub
   
errCancel:
Exit Sub
       
End Sub

Código para lista de valores del operador IN de SQL en Excel

En un post reciente en PowerPivot(Pro), Matt Allington recomienda adquirir conocimientos básicos de SQL para agilizar y mejorar nuestro trabajo con el PowerPivot. Sin lugar a dudas un buen consejo pero no sólo para los usuarios de PowerPivot sino para todo usuario de Excel (en esta nota he mostrado un uso de SQL con Excel).

En este post no voy a hablar de como usar SQL y supongo que sólo interesará a aquellos lectores que ya hacen algún uso de este lenguaje.

En la nota mencionada Matt publica un código de Vba para crear la lista de valores de un operador IN (devuelve  aquellos registros cuyo campo indicado coincide con alguno de una lista).

Para usar este operador hay que crear una lista de valores, texto o números, separados por comas.

Una de las formas de hacerlo es usando la función CONCATENAR, pero cuando se trata de varios miembros a unir, la tarea se vuelve irritántemente tediosa.

Así que, como Matt, también yo he creado un código que uso en mi trabajo diario y que hasta ahora no había pensado en publicarlo. El código es el siguiente

Sub cadena_for_SQL()
  
    Dim cell As Range, strTmp As String, string_for_SQL As String
    Dim SQLString As DataObject
    Dim Answ
  
    Answ = MsgBox("Yes para texto - No para numeros", vbYesNo, "SQL String")
  
    Set SQLString = New DataObject
  
    For Each cell In Selection
        If Answ = vbYes Then
            strTmp = strTmp & "'" & cell.Value & "',"
        Else
            strTmp = strTmp & cell.Value & ","
        End If
    Next cell
  
    string_for_SQL = "IN " & "(" & Left(strTmp, Len(strTmp) - 1) & ")"
  
    With SQLString
        .SetText string_for_SQL
        .PutInClipboard
    End With
  
End Sub

Empezamos por seleccionar el rango que contiene los valores a integrar a la lista del operador IN y
luego activamos la macro; aparecerá un mensaje que nos pide determinar si los valores deben integrarse como texto o como números

Elegimos la opción deseada y la macro copiará la lista al Clipboard. De esta manera todo lo que nos queda por hacer es pegar la lista en el lugar deseado (por lo general, el editor de SQL).

Este video muestra el uso del código en sus dos versiones (texto y valores numéricos)

Ocultar y mostrar filtros en tablas dinámicas seleccionadas

En el post anterior prometí subir una macro que no sólo nos permita ocultar los filtros de una tabla dinámica sino también que nos permita sobre que tablas actuar cuando hay más una en la hoja activa.

Supongamos este caso donde tenemos tres tablas (o mejor dicho, reportes) dinámicas en la hoja

Nuestro objetivo es seleccionar qué tablas aparecerán con filtros de campos y cuáles no. Para eso debemos tener la posibilidad de seleccionar sobre qué tablas aplicar la macro.

Este video muestra el funcionamiento de la macro




El cuaderno con los códigos y el userform puede descargarse aquí.

La macro funciona con un Userform y los códigos de sus elementos 

y una sub para disparar el userform

Para utilizar la macro podemos guardarla en el cuadero Personal y crear un atajo en la barra de acceso rápido o usar Alt+F8 - Ejecutar

Ocultar filtros en todas las tablas dinámicas de una hoja

Gustavo, colega en el trabajo, es uno de esos tipos que pueden causarte un otoño capilar prematuro con sus observaciones. En particular porque siempre le encuentra la quinta pata al gato, siempre habrá algún pero.
Así que cuando vio mi macro para mostrar u ocultar filtros de tablas dinámicas, no pudo menos que decirme: "muy bien, ¿pero si hay más de una tabla dinámica en la hoja?
Es bastante común que haya más de una tabla dinámica en una hoja por lo que tendremos que dar una solución al planteo de Gustavo.

Modificar la macro propuesta en la nota anterior para que muestre u oculte todos los filtros de todas las tablas dinámicas en la hoja activa es sencillo. Supongamos esta hoja con dos tablas dinámicas

Para ocultar los filtros de las dos tablas a la vez usamos este código

 Sub ocultar_Filtros_all()  
   Dim ptbl As PivotTable  
   Dim pfld As PivotField  
   For Each ptbl In ActiveSheet.PivotTables  
    For Each pfld In ptbl.PivotFields  
      pfld.EnableItemSelection = False  
    Next pfld  
   Next ptbl  
 End Sub  

Para restaurar los filtros usamos este otro código

 Sub mostrar_Filtros_all()  
 Dim ptbl As PivotTable  
 Dim pfld As PivotField  
   For Each ptbl In ActiveSheet.PivotTables  
    For Each pfld In ptbl.PivotFields  
      pfld.EnableItemSelection = True  
    Next pfld  
   Next ptbl  
 End Sub  

Para que nuestra macro sea realmente útil tenemos que agregar la posibilidad de seleccionar que tablas queremos modificar, lo cual será el tema del próximo post.

Excel y el problema de los separadores (definiciones regionales)

En más de una oportunidad a lo largo de la historia de este blog me he topado con el problema de los separadores y las definiciones regionales. En ciertos países se usa la coma para separar los miles  y el punto para los decimales mientras que en otros el uso se invierte.
Lo mismo sucede con los separadores de filas y columnas que usamos en las constantes matriciales. Si nos atenemos a la ayuda de Excel usaremos la coma para crear una constante matricial orientada horizontalmente

y el punto y coma para una orientada verticalmente

Sin embargo, en ciertas definiciones regionales, Excel usa el caracter "\" como separador.

Para saber qué caracteres usa Excel para los distintos separadores podemos usar una macro para exponer los valores de la propiedad Application.International. Esta tabla muestra los índices de los distitntos valores

El código para mostrar los valores en un MessageBox es el siguiente

 Sub mostrar_separadores()  
 Dim strSep As String  
 With Application  
   strSep = "Separador de elementos de matriz alternativo =" & .International(xlAlternateArraySeparator) & vbCrLf  
   strSep = strSep & "Separador de Columna =" & .International(xlColumnSeparator) & vbCrLf  
   strSep = strSep & "Separador Decimal =" & .International(xlDecimalSeparator) & vbCrLf  
   strSep = strSep & "Separador de Lista =" & .International(xlListSeparator) & vbCrLf  
   strSep = strSep & "Separador de Fila =" & .International(xlRowSeparator) & vbCrLf  
   strSep = strSep & "Separador de Miles =" & .International(xlThousandsSeparator) & vbCrLf  
   MsgBox (strSep)  
 End With  
 End Sub  

Al correr el código veremos este mensaje

Señalar rangos de nombres definidos - versión mejorada

En la nota anterior mostré como hacer visibles los rangos de nombres definidos en una hoja de Excel.  Uno de mis lectores me pregunta si se puede mejorar la macro de manera que cada rango se señale con un color de fondo distinto.
Para hacerlo tendremos que modificar un poco el código de la macro de la nota anterior, agregando el mecanismo para crear colores de fondo en forma aleatoria. Además tendremos que asegurarnos que el tono de los colores no oculte el contenido de las celdas.

El código modificado es el siguiente:

 Sub mostrar_nombres_dif_color()  
   Dim n As Name  
   Dim strNameStart As String  
   On Error Resume Next  
   Application.ScreenUpdating = False  
   For Each n In ActiveWorkbook.Names  
     With Range(n.RefersTo).Interior  
       .ColorIndex = Int((56 * Rnd) + 1)  
       .TintAndShade = 0.9  
     End With  
     strNameStart = Left(n.RefersTo, WorksheetFunction.Find(":", n.RefersTo) - 1)  
     With Range(strNameStart)  
       .AddComment  
       .Comment.Text n.Name  
       .Comment.Visible = False  
     End With  
   Next n  
   Application.ScreenUpdating = True  
   On Error GoTo 0  
 End Sub  

Como puede apreciarse estoy usando la expresión Int((56 * Rnd) + 1) para generar números enteros entre 1 y 56. Como alguno de estos colores son oscuros e impedirían ver el contenido de las celdas, usamos la propiedad .TintAndShade con un valor de 0.7 para obtener tonos pálidos. Si queremos tonos má claros usamos números más cercanos al 1, por ejemplo 0.85.

El resultado puede verse en esta animación

He agregado la sentencia On Error Resume Next para evitar la interrupción de la rutina si en la primer celda del rango ya existe un comentario. En ese caso el comentario original quedará y no se registrará el nombre del rango.

Como cuestión de buena práctica recomiendo no usar  On Error Resume Next tal como se ve en el código. Pero me permito esta licencia ya que se trata de una pequeña herramienta que puede resultar útil al construir modelos complejos.

Generar con Excel una lista de todas la permutaciones posibles

Cómo generar una lista con todas las permutaciones posibles usando Excel es una de las consultas recurrentes que recibo.
En este post publico una rutina de Vb (macro) que permite hacerlo, pero me apresuro a aclarar que el código no es de mi autoría. El código fue publicado por John Walkenbach en esta página y él a su vez aclara que no conoce el autor del algoritmo.

Entrando más en tema, todas la permutaciones posibles de un grupo de un conjunto de elementos (números o letras) está dado por el factorial de ese número. Por ejemplo, a partir del número 123 se pueden crear seis combinaciones(=FACT(3)=6):

• 123
• 132
• 213
• 231
• 312
• 321

El número de permutaciones crece violentamente con el número de elementos, como puede verse en esta tabla (calculada con la función FACT):

Por este motivo el código permite calcular las permutaciones de hasta 8 elementos.

Los resultados aparecen siempre a partir de la celda A1 de la hoja activa.

Para obtener las permutaciones activamos la rutina GetString, que comprueba si el texto ingresado tiene más de 1 caracter o menos de 9, y luego llama a la rutina GetPermutation.

Option Explicit

Dim CurrentRow

Sub GetString()
    Dim InString As String

    InString = InputBox("Ingrese el numero o texto")
    If Len(InString) < 2 Then Exit Sub
    If Len(InString) >= 8 Then
        MsgBox "Demasiadas permutaciones"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        CurrentRow = 1
        Call GetPermutation("", InString)
    End If
End Sub

Sub GetPermutation(x As String, y As String)
'   Algoritmo de autor desconocido

    Dim i As Integer, j As Integer
    j = Len(y)
    If j < 2 Then
        Cells(CurrentRow, 1) = x & y
        CurrentRow = CurrentRow + 1
    Else
        For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
        Next
    End If
End Sub

Tamaño de los comentarios en Excel - macro mejorada

Las advertencias sobre la falta de control de errores en la macro de la nota anterior sobre el manejo del tamaño de los comentarios no aliviaron mi conciencia. Estoy seguro que alguno de mis lectores habrá adoptado la macro e intentado usarla para impresionar a su jefe (o, mejor aún, a su secretaria) descubriendo en el intento que si se ingresan datos incorrectos, la macro falla mostrando con poca gracia el consabido mensaje

Aquí publico una versión mejorada, con control de errores y con un formulario para ingresar los valores de la altura y el ancho del cuadro en una sola operación.

En un módulo común del editor de Vb ponemos estos códigos

Sub abrir_uf()
    ufDimensiones.Show
End Sub

Sub cambiar_dimension_comentario_3(x As Double, y As Double)

    Dim shComment As Comment

    Unload ufDimensiones

    For Each shComment In ActiveSheet.Comments
        With shComment
            .Shape.Width = x
            .Shape.Height = y
        End With

    Next shComment

End Sub


El primer código abre el formulario (Userform) donde ponemos las dimensiones deseadas para los comentarios. El segundo recibe los datos del formulario y los aplica a los comentarios.

Una vez diseñado el Userform

agregamos los códigos en el módulo del userform

Private Sub cbCancelar_Click()
    Unload ufDimensiones
End Sub

Private Sub cbAceptar_Click()
    Dim pntAltura As Double, pntAncho As Double

    On Error GoTo NoEsNumero
    With ufDimensiones
      
        pntAltura = .tbxAltura / 2.54 * 72
        pntAncho = .tbxAncho / 2.54 * 72
    
    End With
    

    Call cambiar_dimension_comentario_3(pntAltura, pntAncho)

    Exit Sub

NoEsNumero:
MsgBox "El valor ingresado no es un numero", vbCritical
MsgBox "Vuelva a intentarlo o apriete Cancelar", vbInformation

End Sub


Este video muestra el funcionamiento de la macro

Controlando el tamaño de los comentarios en la hoja de Excel

Cuando introducimos un comentario en una celda Excel le dá un tamaño predeterminado. El comentario es una forma y como tal tiene propiedades que podemos cambiar. Si hacemos visible el comentario podemos abrir el menú contextual de sus propiedades, como ya he mostrado en este post nueve años atrás

Un lector me consulta sobre cómo cambiar de una el tamaño de todos los comentarios en una celda. En su caso se debe a que cada comentario tiene un tamaño distinto, pero también puede darse el caso de querer cambiar todos los comentarios del tamaño estándar a otro.

La selección multiple de cuadros de texto la hacemos apuntando con el mouse usando la tecla Shift (Mayúsculas)

Pero no podemos hacer lo mismo con los comentarios. Por lo tanto tendremos que echar mano a las macros.

Empezamos con una macro sencilla que selecciona todos los comentarios en la hoja activa y les da un tamaño (altura y ancho) determinado

Sub cambiar_dimension_comentario_1()

    Dim shComment As Comment

    For Each shComment In ActiveSheet.Comments
        With shComment
            .Shape.Width = 108
            .Shape.Height = 82
        End With

    Next shComment

End Sub

Mis atentos lectores habrán notado que en el cuadro de propiedades (la primer imagen del post) la altura y el ancho del comentario aparecen en centímetros, mientras que en el código de la macro usamos otra unidad. El tamaño del cuadro del comentario, y de todas las formas, la expresamos en Vba en "puntos".
En una pulgada, 2.54 centímetros, hay 72 puntos. Para convertir las dimensiones de centímetros a puntos, a los efectos de usarlas en la macro, tenemos que dividir la dimension en centímetros por 2.54 y multiplicar el resultado por 72.

Así que vamos a mostrar una macro más elaborada donde el usuario ingresa las medidas deseadas en centímetros y el código las traduce a "puntos":

Sub cambiar_dimension_comentario_2()

    Dim shComment As Comment
    Dim dblShW As Double
    Dim dblShH As Double

    dblShW = InputBox("Ancho en centimetros?", "Dimensiones del Comentario")
    dblShH = InputBox("Altura en centimetros?", "Dimensiones del Comentario")

    For Each shComment In ActiveSheet.Comments
        With shComment
            .Shape.Width = dblShW * (72 / 2.54)
            .Shape.Height = dblShH * (72 / 2.54)
        End With

    Next shComment

End Sub

En esta macro usamos InputBox sin validación de los valores introducidos, así que deberemos ser cuidadosos de ingresar números reales (Actualización: una versión mejorada está disponible en este post).

Este video muestro el funcionamiento de la macro.

Calcular registros únicos en rangos extensos - otra versión

Supongamos que tenemos una tabla de datos de ventas donde cada registro (fila) nos muestra el país, la ciudad, el cliente, el producto, la cantidad y, por suspuesto, el importe.
Ahora supongamos que nuestro jefe (o jefa) nos pide saber cuantos clientes hay en cada país. Esto significa hacer un recuento de valores únicos.

Cuando se trata de rangos extensos nada mejor que usar tablas dinámicas. Hemos mostrado en el pasado cómo hacerlo, como pueden ver en esta nota.

Excel 2013 cuenta con la función incorparada para registros únicos tal como mostré en esta nota.

Si todavía usamos Excel 2010 y la tabla de datos es extensa, por ejemplo 500 K filas, las técnicas que usan CONTAR.SI son prácticamente inútiles por el tiempo de proceso que demandan. Tampoco Filtro Avanzado con la opción Registro Únicos ofrece una solución eficiente.

El MVP Roger Govier propuso una solución que consiste en construir una tabla dinámica cuya base de datos es otra tabla dinámica; es decir, pivotear una pivot table.

Veamos como es esta técnica. Esta es nuestra tabla de datos

Como nos piden el "recuento distinto", cuántos clientes hay en cada país, construimos esta tabla dinámica

Para que la etiqueta del país se repita en todas las filas usamos Configuración de campo - Diseño e Impresión - Repetir etiquetas de elementos

Otros detalles importantes:

• dar a la tabla formato tabular (por defecto la tabla tiene el formato Compacto);
• quitar los Subtotales del campo País;
• quitar los Totales de las filas y las columnas.

Ahora vamos a construir una segunda tabla dinámica basada en la primera

No es indispensable ubicar la segunda tabla dinámica en la misma hoja como la primera, pero lo hacemos por comodidad.
En esta tabla dinámica ponemos el campo País en el área de las filas y el campo Cliente en el área de los datos. Como Clliente no es un campo numérico, Excel usa la función Cuenta lo que nos da el número de clientes únicos por país

Para completar nuestro modelo debemos agregarle dinamismo, es decir, la capacidad de ampliarse dinámicamente (en ingles: "scalabilty", la capacidad de ir acomodándose a incrementos de datos; la palabra "escalabilidad" no existe en castellano, por lo menos por ahora).
Para hacerlo tenemos que crear un rango dinámico que se refiera a la primer tabla dinámica. Si intentamos definir la tabla dinámica como Tabla (Insertar-Tabla) veremos que esto no es posible. Así que echaremos manos a las técnicas "tradicionales", creando un nombre que se refiera al rango en forma dinámica usando la INDICE y CONTARA. En nuestro ejemplo definimos el nombre "rngTablaDatos" que se refiere a esta fórmula:

=Hoja1!$A$3:INDICE(Hoja1!$C:$C,CONTARA(Hoja1!$A:$A)+2)

Otra mejora posible es crear un evento que actualize la tabla cada vez que se genera un cambio en la base de datos, como muestro en esta nota.

Extraer números de cadenas de texto

Hace ya varios años atrás publiqué un post mostrando técnicas para extraer números o letras de cadenas alfanuméricas. A pesar del tiempo transcurrido sigo recibiendo consultas, en particular sobre cómo extraer valores numéricos de cadenas de texto. En el post mencionado mostraba como extraer todos los valores numéricos (o todas las letras), pero muchos lectores consultan sobre cómo extraer algún número en particular.
En este post veremos tres funciones UDF (funciones definidas por el usuario) útiles para ese tipo de tareas.

Función para extraer el primer número de una cadena alfanumérica

Esta función tiene un único argumento, la celda que contiene la cadena de texto de donde queremos extraer el número.

Function ext_primer_num(celda As Range)
    Dim iX As Integer, resultado As String, temp As String

    For iX = 1 To Len(celda)
        temp = Mid(celda, iX, 1)
        If IsNumeric(temp) Then
        resultado = resultado & temp
        End If
    Next iX
  
        ext_primer_num = CDec(Left(resultado, 1))
  
End Function

Función para extraer el último número de una cadena alfanumérica

Como la anterior esta función tienen como único argumento la celda que contiene la cadena de texto.

Function ext_ultimo_num(celda As Range)
    Dim iX As Integer, resultado As String, temp As String

    For iX = 1 To Len(celda)
        temp = Mid(celda, iX, 1)
        If IsNumeric(temp) Then
        resultado = resultado & temp
        End If
    Next iX
  
        ext_ultimo_num = CDec(Right(resultado, 1))
  
End Function


Función para extraer un número número de una cadena alfanumérica

Esta función tiene dos argumentos: la celda que contiene la cadena de texto y el número de orden del valor numérico a extraer.

En este ejemplo ponemos en la celda C2 el número de orden buscado (en nuestro caso, el tercer valor numérico en la cadena). En la celda C10 obtenemos el error #¡VALOR! ya que la cadena contiene sólo dos valores numéricos.

Function ext_num(celda As Range, num_orden As Integer)
    Dim iX As Integer, resultado As String, temp As String

    For iX = 1 To Len(celda)
        temp = Mid(celda, iX, 1)
        If IsNumeric(temp) Then
        resultado = resultado & temp
        End If
    Next iX
  
        ext_num = CDec(Mid(resultado, num_orden, 1))
  
End Function

Recordemos que para poder usar estas funciones debemos copiar el código a un módulo común del editor de Vba. Podemos guardarlas en el cuaderno donde queremos usarlas o en el Personal, para que estén disponibles para todos los cuadernos.

Como crear una presentación Power Point a partir de un cuaderno Excel

Empiezo este post con una aclaración: la autoría del concepto de esta nota y del código son de Mike Alexander y fue publicado en su blog hace unos años atrás.

Como muchos de los posts de este blog, la idea surgió a partir de la inquietud de uno de mis colegas de trabajo. Como muchos de los lectores de este blog, mi colega recoge, transforma, analiza datos y finalmente crea reportes. Estos reportes incluyen, además de tablas, gráficos. El producto final suele ser una presentación PowerPoint, donde pega los gráficos que quiere presentar.
La tarea de pasar los gráficos de Excel a la presentación PowerPoint puede ser engorrosa y tiene sus bemoles, ya sea que los peguemos como imágenes o los liguemos al cuaderno Excel.
Con un poco de código Vba podemos automatizar el proceso de crear una presentación PowerPoint a partir de un cuaderno Excel.

La idea central es crear un cuaderno donde manejamos los datos de los gráficos. Luego creamos hojas, una para diapositiva de la presentación, definiendo el rango de celdas que contiene el gráfico y los elementos que queremos que aparezcan en la diapositiva. El rango debe ser el mismo para todas las hojas. También podemos crear una hoja para el título (la primer diapositiva).

En este ejemplo he creado un cuaderno con cuatro hojas, una para el título de la presentación y las tres restantes para mostrar las ventas por mes de las sucursales

El rango D1:O24 contiene lo que queremos que aparezca en cada una de las diapositivas de la presentación.

Finalmente activamos el código siguiente que creará una presentación de PowerPoint, con una diapositiva por cada hoja del cuaderno:


Sub WorkbooktoPowerPoint()

'Paso 1:  Declarar variables
    Dim pp As Object
    Dim PPPres As Object
    Dim PPSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String
    Dim SlideCount As Integer

'Paso 2:  Abrir PowerPoint, agregar una nueva presentacion
         'y volverla visible visible
    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
 

'Paso 3:  Definir el rango de las hojas que contiene la diapositiva
    MyRange = "D1:O24"

'Paso 4:  Empezar el loop por las hojas del cuaderno
    For Each xlwksht In ActiveWorkbook.Worksheets
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))

'Paso 5:  Copiar el rango como imagen
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture

'Paso 6:  Contar las diapositivas y agregar una nueva
        '(el numero 12 representa la enumeracion para una
        'diapositiva en blanco)
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    PPSlide.Select
        
'Paso 7:  Pegar la imagen y ajustar la posicion
    PPSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 50
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 700

 
    Next xlwksht
     
'Paso 8:  Limpiar la memoria
    pp.Activate
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing
              
End Sub

Este video muestra el proceso de creación de la presentación