Seleccionar o hacer referencia a celdas o rangos mediante VBA





Cuando se programa Excel con  VBA, siempre es necesario seleccionar o referenciar a hojas, celdas, filas, columnas o rangos para realizar una  macro de Excel o VBA,  aquí les presento las distintas formas de seleccionar o hacer esas referencias, en el post se presenta también como hacer referencia o seleccionar  una celda usando variables lo cual  es también bastante usado en macros de VBA; los ejemplos de macros que se han publicado en este sitio web; como ser copiar varios ítems seleccionados de  un  listbox a celdas de Excel, o como llenar un listbox dependiendo del dato seleccionado en  un combobox, o  también como llenar un  listbox que depende a su vez de otro listbox y de un combobox; se puede observar el frecuente uso de la selección o referencia a celda, lo cual es muy común a toda macro de Excel o procedimiento de VBA para Excel que sea desarrollado usando Visual Basic para Aplicaciones o VBA; referenciar  a celdas también  tiene uso si se trabaja con userform, esto se puede observar en también en el procedimiento que calcula un saldo entre fecha y fecha o en este  procedimiento para buscar datos en tres columnas, en fin son un sin número de procedimientos que requieren saber hacer  referencia o seleccionar celdas, aquí te presento los más comunes.

Recomiendo que leas un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.




  

En los vídeos siguientes se expone en forma visual la explicación de cada uno de los códigos:










A continuación se expone los distintos códigos sobre como hacer referencia o selecciona una celda, hojas, celdas, filas, columnas o rangos con  su correspondiente explicación, relacionado con las distintas formas de referenciar o seleccionar celdas te puede resultar de utilidad el post como copiar, cortar y pegar datos en celdas con una macro usando VBA.




'Hacer referencia a todas las hojas del libro activo
ActiveWorkbook.Sheets.Select
http://share.payoneer-affiliates.com/a/clk/2mhvGX
MASTERCARD PAYONEER

'Hacer referencia a la hoja2
Sheets("Hoja2").Select

'Hacer referencia a la hoja que se encuentra en la posición 2 sin importar el nombre
Sheets(2).Select

'Hacer referencia a la hoja de la pestaña anterior a la activa
ActiveSheet.Previous.Select

'Hacer referencia a la hoja de la pestaña posterior a la activa
ActiveSheet.Next.Select

'Hacer referencia a una celda de otro libro
Application.Goto Workbooks("Libro1.xlsm").Sheets("Sheet1").Cells(7, 6)

'Hacer referencia a una hoja guardando en una variable el nombre de la hoja activa, previa a la activa y posterior a la activa
Dim sheetnom As String
'Se guarda el nombre de la hoja activa, previa a la activa y posterior a la activa
sheetnom = ActiveSheet.Name
sheetnom = ActiveSheet.Previous.Name
sheetnom = ActiveSheet.Next.Name

'Hacer referencia  a una hoja guardando en una variable el número de hoja, actual, previa a la actual y siguiente
Dim sheetnumb As Byte
sheetnumb = ActiveSheet.Index
sheetnumb = ActiveSheet.Previous.Index
sheetnumb = ActiveSheet.Next.Index

'Selecciona la celda b8 de la hoja 1
Sheets("hoja1").Select
Range("C8").Select

'Hacer referencia de otra forma a la misma celda c8
Cells(8, 3).Select

'También podemos hacer  referencia a la celda C8 pero de la hoja 2
Sheets("hoja2").Select
Cells(8, 3).Select

'Se puede seleccionar la celda c8 de la hoja activa mediante
ActiveSheet.Cells(8, 3).Select

'Selecciona el rango continuo c2 a d10
Range("C2:D10").Select

'Selecciona todas las celdas de la hoja
Cells.Select

'Copiar todas las celdas de la hoja1 a la hoja2
Sheets("hoja1").Cells.Copy Destination:=Sheets("hoja1").Range("A1")
                                                                                   
'Referencia de otra forma el rango c2:d10
Range(Cells(2, 3), Cells(10, 4)).Select

'Referenciar  de otra forma el rango c2:c10
Range("C2", "D10").Select

'Seleccionar toda la columna  B
Range("A:A").Select

'Seleccionar todas las columnas desde la columna A hasta la columna C
Range("A:C").Select

'Seleccionar toda la fila 4
Range("4:4").Select

'Seleccionar todas las filas desde la fila 1 hasta la fila 5
Range("1:5").Select

'Fijarse porque no funciona
'Selecciona el rango discontinuo c5 a g5; a6; f3 a h3 y c24
Range("C5:G5,A6,F3:H3,C24").Select

'Seleccionar la unión de dos o más rangos especificados, similar a seleccionar  y tener apretado tecla ctrl
Application.Union(Range("A2: C5"), Range("F6: H12")).Select

'Seleccionar dos más columnas de columnas no contiguas de longitud variable
Set a = Range("A1", Range("A1").End(xlDown))
Set b = Range("E1", Range("E1").End(xlDown))
Union(a, b).Select

'Seleccionar un rango mayor al anteriormente seleccionado, el rango se amplía a 10 filas, 4 columnas
Range("D10").Select
Selection.Resize(10, 4).Select

'Seleccionar un rango mayor al anteriormente seleccionado, estableciendo la cantidad de fila y columnas adicionales a seleccionar
Range("C2:D10").Select
Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count + 4).Select

'Seleccionar desde la celda E2 hasta la última celda con datos hacia abajo, similar a ctrl + shift + flecha hacia  abajo
Range("E2", Range("E2").End(xlDown)).Select
'Otra forma de seleccionar
Range("E2:" & Range("E2").End(xlDown).Address).Select

'Seleccionar desde la celda E2 hasta la última celda con datos hacia la derecha, similar a ctrl + shift + flecha hacia la derecha
Range("E2", Range("E2").End(xlToRight)).Select
'Otra forma de seleccionar
Range("E2:" & Range("E2").End(xlToRight).Address).Select

 
'Seleccionar desde la celda E2 hasta la última celda con datos hacia la izquierda, similar a ctrl + shift + flecha hacia la izquierda
Range("E2", Range("E2").End(xlToLeft)).Select

'Otra forma de seleccionar
Range("E2:" & Range("E2").End(xlToLeft).Address).Select

'Seleccionar desde la celda E2 hasta la primer celda con datos desde abajo, similar a ctrl + shift + flecha hacia arriba
Range("E2", Range("E1048576").End(xlUp)).Select
'Otra forma de seleccionar
Range("E2:" & Range("E1048576").End(xlUp).Address).Select

'Seleccionar mediante  variables y cells un rango hacia la  derecha
Sheets("ApiladoVertical").Range((Cells(filaAV, 1)), Range((Cells(filaAV, 1)), Cells(filaAV, 1)).End(xlToRight)).Select

'Seleccionar la última celda con datos hacia abajo, similar a ctrl + flecha hacia  abajo
Range("E2").End(xlDown).Select
'Seleccionar la última celda con datos hacia la derecha, similar a ctrl + flecha hacia la derecha
Range("E2").End(xlToRight).Select

'Seleccionar la última celda con datos hacia la izquierda, similar a ctrl + flecha hacia la izquierda
Range("E2").End(xlToLeft).Select

'Seleccionar desde la celda E1048576 la primer celda con datos hacia arriba, similar a ctrl + flecha hacia arrib a
Range("E1048576").End(xlUp).Select

'Hacer referencia a la ultima celda sin datos
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select

'Hacer referencia a la ultima columna sin datos
ActiveSheet.Range("a1").End(xlDown).Offset(0, 1).Select

'Hacer referencia a la dirección de la última celda hacia abajo con datos
Dim addr As String
Range("E2").End(xlDown).Select
'dirección en forma absoluta (Ej: $E$50)
addr = Selection.Cells(1, 1).Address
'dirección en forma relativa (Ej: B50)
addr = Selection.Cells(1, 1).Address(False, False)

'Hacer referencia a la dirección de la última celda hacia la derecha con datos
Dim addrc As String
Range("E2").End(xlToRight).Select
'dirección en forma absoluta (Ej: $E$50)
addrc = Selection.Cells(1, 1).Address
'dirección en forma relativa (Ej: B50)
addrc = Selection.Cells(1, 1).Address(False, False)
http://4ca829kpkqrc3n56sdsys6hebk.hop.clickbank.net/?tid=CURSOVB
CURSO DE MACROS

'Referenciar al numero de la ultima fila con datos continuos
Dim uf As String
Range("E2").End(xlDown).Select
uf = ActiveCell.Row

'Referenciar al numero de la ultima columna con datos continuos
Dim uc As String
Range("E2").End(xlToRight).Select
uc = ActiveCell.Column

'Hacer referencia a la ultima fila con datos
uf = Sheets("hoja2").Range("A" & Rows.Count).End(xlUp).Row

'Referenciar a la ultima fila con datos de la columna A de otra forma
uf = Cells(1048576, 1).End(xlUp).Row

'Referenciar a la ultima columna con datos de la fila 1 de otra forma
uc = Cells(1, 16384).End(xlToLeft).Column

'Selecciona  y combina las celdas selecciondas
Range("B1:E1").Select
Selection.Merge

'Selecciona  y descombina las celdas selecciondas
Range("B1:E1").Select
Selection.UnMerge

'Selecciona un rango donde se  encuentra la celda activa
Range("B2").CurrentRegion.Select

'Otra forma de selecciona un rango donde se  encuentra la celda activa
ActiveSheet.Range("e2", ActiveSheet.Range("e2").End(xlDown).End(xlToRight)).Select

'Otra forma de selecciona un rango donde se  encuentra la celda activa
ActiveSheet.Range("e2:" & ActiveSheet.Range("e2").End(xlDown).End(xlToRight).Address).Select

'Selecciona un rango donde se  encuentra la celda activa,pero habiendo una fila sin datos en el rango
lastCol = ActiveSheet.Range("E2").End(xlToRight).Column
lastRow = ActiveSheet.Cells(E1048576, lastCol).End(xlUp).Row
ActiveSheet.Range("E2", ActiveSheet.Cells(lastRow, lastCol)).Select

'Selecciona la última celda con datos independientemente si existen celdas vacias en medio, es decir
'selecciona la ultima celda del rango formado entre la ultima columna con datos y la ultima fila con datos
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select

'Selecciona la última celda con datos independientemente si existen celdas vacias en medio, es decir
Dim addr1 As String
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
Selection.End(xlToLeft).Select
addr1 = Selection.Cells(1, 1).Address(False, False)

'Hacer referencia a la ultima columna sin datos
'Selecciona la última sin datos independientemente si existen celdas vacias en medio, es decir
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
Selection.End(xlToLeft).Offset(1, 0).Select

'Hacer referencia a todo el rango con datos independientemente si existen celdas vacias en medio
Dim addr2 As String
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
addr2 = Selection.Cells(1, 1).Address(False, False)
Range("A1:" & addr2).Select


En el vídeo encontrarás la primer parte de la explicación sobre como seleccionar o referenciar celdas en Excel.




'Hacer referencia y seleccionar todo el rango con datos independientemente si existen celdas vacias en medio y dar nombre al rango
'Es igual a ir al menu formulas, asignar nombre y luego definir nombre.
Dim addr3 As String
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
addr3 = Selection.Cells(1, 1).Address(False, False)
Range("A1:" & addr3).Select
ActiveWorkbook.Names.Add Name:="myrange", RefersTo:="=Hoja2!" & Selection.Address
Range("myrange").Select

'Hacer referencia a la celda con un determinado valor en todo el rango que contenga datos
Dim addrt, addrsel As String
Dim cell As Range
Dim searchvalue As Integer
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
addrt = Selection.Cells(1, 1).Address(False, False)
Range("A1:" & addrt).Select
searchvalue = 15
For Each cell In Selection
If cell = searchvalue Then addrsel = cell.Address(False, False)
Next cell
Range(addrsel).Select
addrt = Selection.Address(False, False)

'Seleccionar un rango usando una variable que determina el rango
Dim Ran1 As String
Ran1 = "B5:C18"
Range(Ran1).Select

'Selecciona la celda mediante una variable que obtiene su valor de la celda B5
Dim file As String
file = Range("B5").Value
ActiveSheet.Select
Range("B" & file).Select

'Selecciona la celda A2 mediante una variable cuyo valor es dado
Dim file1 As Integer
file1 = 2
Range("A" & file1).Select

'Seleccionar un rango cuya última fila está dada por el valor de una celda
Dim filfree As Integer
filfree = Range("C1").Value
Range("A1" & ":E" & filfree).Select

'Seleccionar un rango cuya última columna está dada por el valor de una celda
Dim colfree As Integer
colfree = Range("A28").Value
Range(Cells(3, 2), Cells(5, colfree)).Select

'Seleccionar un rango cuya última columna está dada por el valor de la celdaactual
Dim colfree1 As Integer
colfree1 = ActiveCell.Column
Range("B2" & ":E" & colfree1).Select

'Referenciar en forma relativa a celdas es decir a cierta distancia de la celda activa, en otras palabras a tantas  filas  y tantas columnas de la celda actual.
'Selecciona desde A1 8 filas hacia abajo y 15 columnas hacia la derecha
Sheets("hoja2").Range("A1").Offset(8, 15).Select

'Selecciona a 3 filas anteriores y 1 columna hacia la izquierda de la celda actual
ActiveSheet.Range("h10").Offset(-3, -1).Select

'Selecciona desde la celda activa 4 filas hacia abajo  y 2 columnas hacia la derecha
ActiveCell.Offset(4, 2).Select

'Selecciona a 3 filas anteriores y 2 columna hacia la izquierda de la celda actual
ActiveCell.Offset(-3, -2).Select

'Seleccionar celdas en forma relativa que no sea la celda actual
ActiveSheet.Range("C7").Offset(5, 4).Select

'También se puede usar
ActiveSheet.Cells(7, 3).Offset(5, 4).Select

'Seleccionar un rango especificado, luego desplazar la seleccion en forma relativo y cambiar el tamaño de la selección
Range("C2:E5").Select
Selection.Offset(4, 3).Resize(Selection.Rows.Count + 2, Selection.Columns.Count + 1).Select
               
'Cuenta el número de filas con datos continuos
Dim nfil  As Integer
Range("E2", Range("E2").End(xlDown)).Select
nfil = Selection.Rows.Count

'Cuenta el número de columnas con datos continuos                                    
Dim ncol As Integer
Range("E2", Range("E2").End(xlToRight)).Select
nrocol = Selection.Columns.Count

'Cuenta la cantidad de objetos celdas en un rango
Dim nceldas As Integer
Range("E2").CurrentRegion.Select
nceldas = Selection.Cells.Count

'Seleccionar la intersección de dos o más rangos, un rango debe estar intersectado con el otro sino da error
Application.Intersect(Range("A2:C5"), Range("B2:C4")).Select




Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.



If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Calor Afuera






Humor Gráfico
Calor Afuera ?







MASTERCARD PAYONEER
  1. Trucos de Excel
  2. Macro que envía mail y emite formulario de aviso
  3. Macro Alerta mediante parpadeo de celda
  4. Glosario de palabras usadas en VBA para Excel
  5. Forma de seleccionar o hacer referencia a celdas, rangos y hojas






Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Listbox de Excel de varias columnas copia items seleccionados a celdas




En un foro sobre macros de Excel o VBA,  me preguntan como copiar varios ítems seleccionados de  un  listbox a celdas de Excel, un post anterior se expuso un ejemplo de marcro sobre como llenar un listbox dependiendo del dato seleccionado en  un combobox, también como llenar un  listbox que dependía a su vez de otro listbox y de un combobox; pero quedaba pendiente como pasar esos datos a las celdas de Excel, pero sobre  todo como pasar varios datos seleccionados en un  listbox de Excel a las celdas de Excel; buen pues aquí les muestro con un sencillo ejemplo como se hace macro de Excel o procedimiento de VBA para Excel desarrollado íntegramente Visual Basic para Aplicaciones, también en este ejemplo se hace depender los datos encontrados del valor previamente ingresado en combobox, una vez encontrados y cargados los datos en el listbox, en ocasiones resulta necesario copiarlos a las celdas, bueno eso precisamente hace esta macro,  encuentra los datos seleccionados en el combobox, los carga en el listbox, con estos datos cargados se pueden seleccionar uno o varios ítems, previamente cuando se carga el listbox se establece la propiedad del listbox en "ListBox1.MultiSelect = fmMultiSelectMulti"; para que de esta  manera sea posible seleccionar varios ítems; una vez seleccionados al hacer  click en el botón copy, se pegan los datos en la hoja dos, también la  macro se puede hacer que se corra en el evento dobleclik o click de mouse y de esa  manera con  un click se copien los datos.
La macro VBA excel corre  al apretar el  botón que llama al formulario, en el formulario existe un  combobox, un listbox y dos botones de comando que hacen que se copien los datos en la hoja2.
   
Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo, debes hacer click acá, si quieres un libro sobre Excel, en inglés, entonces debes hacer click acá.

El código que se encuentra a continuación se debe ingresar en un  userform, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.
Podrás ver como funciona al descargar el ejemplo de la macro , lo cual facilita mucho su comprensión, si bien se trata de hacer los ejemplos lo más fácil posible, algún conocimiento en VBA se debería tener para poder modificar las macros y adaptarla para de este modo automatizar tu libro excel.


Código que se debe ingresar en userform


Private Sub Combobox1_Change()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila, a As Integer
On Error Resume Next
'Borra datos del listbox
ListBox1.Clear
a = 0
fila = 2
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, 5) <> Empty
      dato = Combobox1
'Si el dato de la fila coincide con textbox carga los datos al listbox
  Var = Sheets("hoja1").Cells(fila, 5)
   If Sheets("hoja1").Cells(fila, 5) = dato Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub

'Código buttom cancel
Private Sub CommandButton1_Click()
Unload Me
End Sub


'Código buttom copy
Private Sub CommandButton2_Click()
Application.ScreenUpdating = True
Dim uf, a As Integer
uf = Sheets("hoja2").Range("A" & Rows.Count).End(xlUp).Row
uf = uf + 1
a = ListBox1.ListCount
For a = 0 To a - 1
   
   If ListBox1.Selected(a) Then
   Sheets("hoja2").Cells(uf, 1) = ListBox1.List(a, 0)
   Sheets("hoja2").Cells(uf, 2) = ListBox1.List(a, 1)
   Sheets("hoja2").Cells(uf, 3) = ListBox1.List(a, 2)
   Sheets("hoja2").Cells(uf, 4) = ListBox1.List(a, 3)
   Sheets("hoja2").Cells(uf, 5) = ListBox1.List(a, 4)
   uf = uf + 1
   End If
  
Next a
Unload Me
Sheets("hoja2").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub


 
Private Sub UserForm_Initialize()
'Propiedad del listbox para poder seleccionar varios items
ListBox1.MultiSelect = fmMultiSelectMulti
Label2.Caption = Sheets("hoja1").Cells(1, 1)
Label3.Caption = Sheets("hoja1").Cells(1, 2)
Label4.Caption = Sheets("hoja1").Cells(1, 3)
Label5.Caption = Sheets("hoja1").Cells(1, 4)
Label6.Caption = Sheets("hoja1").Cells(1, 5)
Combobox1.AddItem ("Ventas")
Combobox1.AddItem ("Cobranzas")
Combobox1.AddItem ("Deposito")
Combobox1.AddItem ("Contaduria")
Combobox1.AddItem ("Legales")
End Sub



Código que  se debe ingresar en un módulo

Sub form()
UserForm1.Show
End Sub





Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Llenar listbox dependiendo de otro listbox y combobox con vba para excel




En un post anterior se expuso un ejemplo de marcro sobre como llenar un listbox dependiendo del dato seleccionado en  un combobox, aquí presento esta macro de Excel o procedimiento de VBA para Excel desarrollado íntegramente Visual Basic para Aplicaciones, también en este ejemplo se hace depender los datos encontrados del valor que es previamente ingresado en combobox, la variante es que no sólo depende de un combobox, sino que depende de otro listbox, el ejemplo muestra como llenar un listbox dependiendo de otro listbox y combobox; resumiendo los datos que muestra  el listbox1, van a depender del valor seleccionado en el combobox y luego de los datos seleccionados en el listbox2. 
La macro VBA excel corre  al apretar el  botón que llama al formulario, en el formulario existen, un  combobox, dos listbox y botón de opciones, que nos permiten definir el orden  que le quisiéramos dar a los datos encontrados, es decir ascendente o descendente.
Al elegir un dato en el combobox, que se dota de datos al cargarse el formulario, se realiza una búsqueda de datos que luego son cargados en el listbox correspondiente; si se hace doble click en algún dato de los desplegados en el listbox, se procede  a realizar otra búsqueda de datos que son cargados en el listbox destinado a ello.
Los botones de opciones se ponen para que si se desea se pueda ordenar en forma  ascendente o descendente, según como se prefiera, dichas opciones se han puesto en cada uno de los listbox que se presenta en el ejemplo.
  
Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo, debes hacer click acá, si quieres un libro sobre Excel, en inglés, entonces debes hacer click acá.

El código que se encuentra a continuación se debe ingresar en un  userform, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.
Podrás ver como funciona al descargar, desde el link del final, el ejemplo de la macro, lo cual facilita mucho su comprensión, si bien se trata de hacer los ejemplos lo más fácil posible, algún conocimiento en VBA se debería tener para poder modificar las macros y adaptarla para de este modo automatizar tu libro excel.


Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del listbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
 
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Mostrar el número de entradas en el ListBox1.
UserForm1.Label8.Caption = "Total Registros: " & a + 1


'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub

Private Sub Combobox1_Change()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila2, colum2, b, uf As Integer
Dim col As String
'Dim ran As Range
Dim DSR As New Collection
On Error Resume Next
'Borra datos del listbox
ListBox2.Clear
b = 0
fila2 = 2
'Selecciono columna donde buscar
dato = Combobox1
Select Case dato
Case "Departamento"
colum2 = 5
Case "Nacionalidad"
colum2 = 2
Case "Estado"
colum2 = 3
End Select
Select Case colum2
Case 5
col = "E"
Case 2
col = "B"
Case 3
col = "C"
End Select
'Determina rango de datos a cargar al listbox
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
ran = col & fila2 & ":" & col & uf
For Each Celda In Range(ran)
DSR.Add Celda.Value, CStr(Celda.Value)
Next Celda
'Agregar elementos a la lista
For Each Item In DSR
UserForm1.ListBox2.AddItem Item
Next Item
'Mostrar el número de entradas en el ListBox1.
UserForm1.Label7.Caption = "Total Registros: " & DSR.Count

'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton1_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "b2" & ":b" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Luego de ordenar corre macro para llenar listbox
Combobox1_Change
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton2_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "b2" & ":b" & uf
'Se usa para filtrar por otro criterio
'r2 = "B2" & ":B" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 'ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
       ' , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Luego de ordenar corre macro para llenar listbox
Combobox1_Change
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton3_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "A2" & ":A" & uf
r2 = "E2" & ":E" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Carga datos ordenados al listbox
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del l istbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub OptionButton4_Click()
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim r1, r2, r3 As String
'determines last row with data
uf = Sheets("hoja1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "A2" & ":A" & uf
r2 = "E2" & ":E" & uf
r3 = "A1" & ":E" & uf
'sorts the data
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 'Segundo criterio de filtrado
 ActiveWorkbook.Worksheets("hoja1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("hoja1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With

'Carga datos ordenados al listbox
Dim fila, a, colum1 As Integer
On Error Resume Next
'Borra datos del l istbox
ListBox1.Clear
a = 0
fila = 2
'Selecciono columna donde buscar
d = Combobox1
Select Case d
Case "Departamento"
colum1 = 5
Case "Nacionalidad"
colum1 = 2
Case "Estado"
colum1 = 3
End Select
'Bucle mientras la fila no esté vacia
While Sheets("hoja1").Cells(fila, colum1) <> Empty
      d = ListBox2.Value
'Si el dato de la fila coincide con textbox carga los datos al listbox
   If Sheets("hoja1").Cells(fila, colum1) = d Then

        'Copia los datos de la celda list box
        a = ListBox1.ListCount
        ListBox1.AddItem
        ListBox1.List(a, 0) = Sheets("hoja1").Cells(fila, 1)
        ListBox1.List(a, 1) = Sheets("hoja1").Cells(fila, 2)
        ListBox1.List(a, 2) = Sheets("hoja1").Cells(fila, 3)
        ListBox1.List(a, 3) = Sheets("hoja1").Cells(fila, 4)
        ListBox1.List(a, 4) = Sheets("hoja1").Cells(fila, 5)
   End If
  
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
End Sub
Private Sub UserForm_Initialize()
Label2.Caption = Sheets("hoja1").Cells(1, 1)
Label3.Caption = Sheets("hoja1").Cells(1, 2)
Label4.Caption = Sheets("hoja1").Cells(1, 3)
Label5.Caption = Sheets("hoja1").Cells(1, 4)
Label6.Caption = Sheets("hoja1").Cells(1, 5)
Label7.Caption = Clear
Label8.Caption = Clear
Combobox1.AddItem ("Departamento")
Combobox1.AddItem ("Nacionalidad")
Combobox1.AddItem ("Estado")

End Sub
     

Código que  se debe ingresar en un módulo

Sub form()
UserForm1.Show
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Macro extrae cadenas de texto o string: Mid, Len ...


Esta macro de Excel íntegramente programada  en VBA muestra como trabajar con cadenas de texto, como siempre el ejemplo de macro se puede bajar en forma gratuita. En el archivo se muestra como se puede a través de macros como se puede modificar cadenas de texto o string, en primer lugar este procedimiento de VBA crea  los encabezados de las columnas, terminado esto realiza un bucle mientras las filas no estén vacías, es decir mientras tengan datos, trabajando en cada fila con textos o string, para ello en la columa A se usa la función StrReverse, que lo que hace es dar vuelta la cadena de texto, en este caso es a los fines de extraer el texto que se encuentra a la derecha del espacio, para saber en que ubicación se encuentra el espació se usa InStr y por último con la  expresión Right se obtiene lo que está a la derecha del espacio, posteriormente se vuelve a dar vuelta la cadena  de texto  y de esta manera se obtuvo el string que se quería obtener, eso se hace con las columas A. En la columna B se hace algo parecido, pero a su vez se usa la función WorksheetFunction.Proper, que lo que hace es darle formato de titulo al texto.

Una vez que se han obtenido las cadenas de texto en la forma que se necesitan, se procede a ordenar para ello se determina la última fila con datos  y en base a ello se obtiene el rango a ordenar, por último formato a las filas.
Es posible que si deseas trabajar con string requieras darle formato de negrita a mayúscula solamente, lo cual lo puedes ver en mis post donde se  expone un ejemplo de como hacerlo, o quizás también necesites cambiar la cadena de texto de mayúscula a minúscula o viceversa 

Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá.

El código que se encuentra a continuación se debe ingresar en un  módulo, descargando el ejemplo, desde el link del final, lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.


Código a insertar en módulo

Sub Format()
Application.ScreenUpdating = False
Dim fila As Integer
Dim r As Range
Dim r1, r2, r3 As String
'starts the loop on row 2
fila = 2
'column headings
Sheets("sheet1").Cells(1, 1) = "CostCenter"
Sheets("sheet1").Cells(1, 2) = "Participant'sName"
Sheets("sheet1").Cells(1, 3) = "Job Name"
Sheets("sheet1").Cells(1, 4) = "ComplDate"
Sheets("sheet1").Cells(1, 5) = "TRNG"
'loop until the last row with data
While Sheets("Sheet1").Cells(fila, 1) <> Empty
'working with string to remove characters requiredin Column 2
cad1 = Sheets("Sheet1").Cells(fila, 1)
lar1 = Len(cad1)
rev = StrReverse(cad1)
esp1 = InStr(rev, " ")
cad1 = Right(rev, (lar1 - esp1))
cad1 = StrReverse(cad1)
'assemble the cell name with the characters extracted
Sheets("Sheet1").Cells(fila, 1) = cad1
'Function.Proper to the cell
Sheets("Sheet1").Cells(fila, 1) = WorksheetFunction.Proper(Sheets("Sheet1").Cells(fila, 1))
'working with string to remove characters required in Column 2
cad2 = Sheets("Sheet1").Cells(fila, 2)
lar2 = Len(cad2)
esp2 = InStr(cad2, " ")
cadape2 = Left(cad2, (lar2 - (lar2 - esp2 + 1)))
cadnom2 = Right(cad2, (lar2 - esp2))
'assemble the cell name with the characters extracted
Sheets("Sheet1").Cells(fila, 2) = cadape2 & ", " & cadnom2
'Function.Proper to the cell
Sheets("Sheet1").Cells(fila, 2) = WorksheetFunction.Proper(Sheets("Sheet1").Cells(fila, 2))
'Function.Proper to the cell
Sheets("Sheet1").Cells(fila, 3) = WorksheetFunction.Proper(Sheets("Sheet1").Cells(fila, 3))
Sheets("Sheet1").Cells(fila, 5) = "OSHA"
'adds a cell to move to the next and to the end of data cells
fila = fila + 1
'next and to the end of data cells
Wend
'determines last row with data
uf = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'will help determine ranges to sort data
r1 = "A2" & ":A" & uf
r2 = "B2" & ":B" & uf
r3 = "A1" & ":E" & uf

'sorts the data
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(r1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(r2) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(r3)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 End With


 'formats applied
 Range("A1").Select
 Range(Selection, Selection.End(xlToRight)).Select
   
        Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
   
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub




     
Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.




If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.




Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Formato a filas dependiendo del valor de una celda


La macro de Excel o procedimiento de VBA, es bastante útil cuando se desea dar formato, pero dependiendo del valor de una celda, en este ejemplo se da color a una fila en forma automática. Como se puede observar en el ejemplo proporcionado, la macro de Excel colorea toda la fila de la celda actual, dependiendo del valor de la celda, en este caso, el valor esta dado por la columna A.

Se puede descargar el ejemplo en forma gratuita, analizarlo  y modificarlo, como se desee, no sólo es posible colorear la fila, sino aumentar el tamaño de la fuente, ancho de fila, color de fuente, poner negrita, mayúscula, minúscula; estos últimos formatos están explicados en forma detallada en un post de este blog, pudiendo encontrarlo en mapa del sitio, en definitiva se puede dar el formato que se desee, todo va a depender del valor de la columna A; haz click en el link del final para bajar el ejemplo.

También en cambiar celda de color a medida que se desplaza por la hoja podrás encontrar una variante parecida, en este caso no se tiene en cuenta el valor de una celda, sino que a medida que se desplaza por las filas de la hoja de cálculo, se van coloreando las celdas, es bastante útil cuando tienes una tabla con muchos datos y no te quieres perder dentro de ella.

Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá.

El código que se encuentra a continuación se debe ingresar en Worksheet, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.


Código a insertar en Worksheet


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
If Target.Cells.Count = 1 And Target.Column = 1 And Target.Text = "Yes" Then
Target.Offset(0, 0).Interior.ColorIndex = 8
Target.Offset(0, 1).Interior.ColorIndex = 8
Target.Offset(0, 2).Interior.ColorIndex = 8
Target.Offset(0, 3).Interior.ColorIndex = 8
Target.Offset(0, 4).Interior.ColorIndex = 8
Target.Offset(0, 5).Interior.ColorIndex = 8
Target.Offset(0, 6).Interior.ColorIndex = 8
Target.Offset(0, 7).Interior.ColorIndex = 8
Target.Offset(0, 8).Interior.ColorIndex = 8
Target.Offset(0, 9).Interior.ColorIndex = 8
Target.Offset(0, 10).Interior.ColorIndex = 8
'Target.Offset(0, 11).Interior.ColorIndex = 8
Target.Offset(0, 12).Interior.ColorIndex = 6
Target.Offset(0, 13).Interior.ColorIndex = 6
Target.Offset(0, 14).Interior.ColorIndex = 6
Target.Offset(0, 15).Interior.ColorIndex = 6
Target.Offset(0, 16).Interior.ColorIndex = 6
'Target.Offset(0, 17).Interior.ColorIndex  =8
Target.Offset(0, 18).Interior.ColorIndex = 4
'Target.Offset(0, 19).Interior.ColorIndex  =8
Target.Offset(0, 20).Interior.ColorIndex = 9
Else
Target.Offset(0, 0).Interior.ColorIndex = xlNone
Target.Offset(0, 1).Interior.ColorIndex = xlNone
Target.Offset(0, 2).Interior.ColorIndex = xlNone
Target.Offset(0, 3).Interior.ColorIndex = xlNone
Target.Offset(0, 4).Interior.ColorIndex = xlNone
Target.Offset(0, 5).Interior.ColorIndex = xlNone
Target.Offset(0, 6).Interior.ColorIndex = xlNone
Target.Offset(0, 7).Interior.ColorIndex = xlNone
Target.Offset(0, 8).Interior.ColorIndex = xlNone
Target.Offset(0, 9).Interior.ColorIndex = xlNone
Target.Offset(0, 10).Interior.ColorIndex = xlNone
'Target.Offset(0, 11).Interior.ColorIndex = xlNone
Target.Offset(0, 12).Interior.ColorIndex = xlNone
Target.Offset(0, 13).Interior.ColorIndex = xlNone
Target.Offset(0, 14).Interior.ColorIndex = xlNone
Target.Offset(0, 15).Interior.ColorIndex = xlNone
Target.Offset(0, 16).Interior.ColorIndex = xlNone
'Target.Offset(0, 17).Interior.ColorIndex = xlNone
Target.Offset(0, 18).Interior.ColorIndex = xlNone
'Target.Offset(0, 19).Interior.ColorIndex = xlNone
Target.Offset(0, 20).Interior.ColorIndex = xlNone
End If
Application.ScreenUpdating = True
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends