Dante muchas gracias pero el detalle es que necesito ejecutar dos veces mi macro para que en mi userform en espeifico la label muestre el total de las etiquetas ya que el conteo si me lo hace correctamente.
Private Sub IMP_ETIQUETA_Click()
Application.ScreenUpdating = False
' QUITAR DESTINO Y CAJA
Range("A2").Select
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.PivotTables("ETIQUETAS").PivotFields("DESTINO").Orientation = _
xlHidden
ActiveSheet.PivotTables("ETIQUETAS").PivotFields("CAJA").Orientation = xlHidden
' AGREGAR DESTINO Y CAJA
With ActiveSheet.PivotTables("ETIQUETAS").PivotFields("DESTINO")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("ETIQUETAS").PivotFields("CAJA")
.Orientation = xlRowField
.Position = 2
End With
' CONTAR
Dim i As Double
Dim final As Double
Worksheets("ETIQUETAS").Select
final = Application.CountA(Worksheets("ETIQUETAS").Range("A:A"))
For i = 2 To final
'Contamos las veces que se repiten cada uno de los nombres en el rango seleccionado
CAJAS = Worksheets("ETIQUETAS").Cells(i, 1).Value
Worksheets("ETIQUETAS").Cells(i, 4).Value = Application.CountIf(Worksheets("ETIQUETAS").Range("A2:A" & final), CAJAS)
Next
'CONCATENAR CAJA / CAJA
Range("A2").Select
Do While ActiveCell.Value <> ""
fila = ActiveCell.Row
If ActiveCell.Value <> "," Then
lista = Format(ActiveCell.Offset(0, 1), "00") & "/" & Format(ActiveCell.Offset(0, 3), "00")
Else
lista = ActiveCell
End If
'coloca cadena en col E
Cells(fila, 5).Value = lista
lista = ""
ActiveCell.Offset(1, 0).Select
Loop
'COPIAR OC
Sheets("ETIQUETAS").Select
finy = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Worksheets("ETIQUETAS").[A2].Select
While ActiveCell.Row <= finy
datoy = ActiveCell
Set buscoy = Sheets("DETALLE").Range("C:C").Find(datoy, LookIn:=xlValues, lookat:=xlWhole)
If Not buscoy Is Nothing Then
colx = Sheets("DETALLE").Cells(buscoy.Row, 6).End(xlToRight).Column
Sheets("DETALLE").Range("A" & buscoy.Row).Resize(1, colx - 5).Copy Destination:=ActiveCell.Offset(0, 5)
End If
ActiveCell.Offset(1, 0).Select
Wend
'BUSCAR RUTA
Sheets("ETIQUETAS").Select
fini = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Worksheets("ETIQUETAS").[A1].Select
While ActiveCell.Row <= fini
dato = ActiveCell
Set busco = Sheets("RUTAS").Range("A:A").Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
colx = Sheets("RUTAS").Cells(busco.Row, 12).End(xlToRight).Column
Sheets("RUTAS").Range("A" & busco.Row).Resize(1, colx - 7).Copy Destination:=ActiveCell.Offset(0, 7)
End If
ActiveCell.Offset(1, 0).Select
Wend
'CONCATENAR ETIQUETA
Range("A2").Select
Do While ActiveCell.Value <> ""
fila = ActiveCell.Row
If ActiveCell.Value <> "," Then
lista = "002" & ActiveCell.Offset & ActiveCell.Offset(0, 5) & Format(ActiveCell.Offset(0, 1), "000")
Else
lista = ActiveCell
End If
'coloca cadena en col E
Cells(fila, 16).Value = lista
lista = ""
ActiveCell.Offset(1, 0).Select
Loop
'BUSCAR ETIQUETAS
Sheets("ETIQUETAS").Select
fn = ActiveSheet.Range("P" & Rows.Count).End(xlUp).Row
Worksheets("ETIQUETAS").[P2].Select
While ActiveCell.Row <= fn
datos = ActiveCell
Set buscos = Sheets("VBA").Range("J:J").Find(datos, LookIn:=xlValues, lookat:=xlWhole)
If Not buscos Is Nothing Then
colx = Sheets("VBA").Cells(buscos.Row, 10).End(xlToRight).Column
Sheets("VBA").Range("J" & buscos.Row).Resize(1, colx - 1).Copy Destination:=ActiveCell.Offset(0, 1)
End If
ActiveCell.Offset(1, 0).Select
Wend
'CONTADOR DE ETIQUETAS
Dim canrow As Integer
canrow = 0
uf = Sheets("ETIQUETAS").Range("Q" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Sheets("ETIQUETAS").Cells(i, 1) <> Empty Then
canrow = canrow + 1
End If
Next i
Worksheets("ETIQUETAS").Range("A1000:A65536").EntireRow.Delete
Worksheets("ETIQUETAS").Range("AD:IV").Columns.Delete
*********** Aqui solicito me pinte el total de etiquetas en mi label de mi user form ********
**Pero requiero correr dos veces estas lineas para que me mande el dato a label *****
Cells(1, 28) = canrow
Impresion.Show
Impresion.canrow.Caption = canrow
Impresion.Et.Caption = Worksheets("ETIQUETAS").Range("AC1")
Et = Worksheets("ETIQUETAS").Range("AB1").Value
Impresión.Hide
End Sub