Excel - cargar msflexgrid

Tengo un problema, en La hoja ("PRE-RUTEO") necesito selecionar un dato de cuaquier celda de la columna "B" y buscarlo en la columna "K" de la hoja ("ASIG 61,10,2"), de encontrarlo que cargue todos los datos asociados en un VSFLEXARRAY1

NOTA:el vsflexarray es similar al msflexgrid, o por lo menos trabajan igual. El vsflexarray1 esta en un formulario UserForm3

Hoja("PRE-RUTEO")

B
Orden:
E0342006
E0342478
E0342005
E0342015
E0342007
E0342382
E0342280
OV277030

Hoja ("ASG 61,10,2")

J----------------K-------------------L
Almc:-------- Orden:-------Fch!Orden:

200--------OV276828---- 21/01/2010
200--------OV277030---- 22/01/2010
200--------OV277031---- 22/01/2010
200--------OV276999---- 22/01/2010
200--------OV277021---- 22/01/2010
200--------E0342407---- 22/01/2010
200--------OV277027----22/01/2010
200--------E0342471---- 22/01/2010
200--------E0342449---- 22/01/2010
200--------E0342478---- 22/01/2010
200--------E0342531---- 22/01/2010
200--------E0342369---- 22/01/2010
200--------E0342491---- 22/01/2010
200--------E0342527---- 22/01/2010
200--------E0342529---- 22/01/2010
200--------E0342382---- 22/01/2010
200--------E0342484---- 22/01/2010
200--------OV277036---- 22/01/2010

"carga el formulario"
Private Sub UserForm_Activate()
Dim W As Integer, Z As Integer
Dim ws1 As Worksheet, FILAAA As Long, FILA1 As Long
vsFlexArray1.Cols = 10
vsFlexArray1.ColWidth(0) = 300
vsFlexArray1.ColWidth(1) = 850
vsFlexArray1.ColWidth(2) = 350
vsFlexArray1.ColWidth(3) = 690
vsFlexArray1.ColWidth(4) = 1850
vsFlexArray1.ColWidth(5) = 580
vsFlexArray1.ColWidth(6) = 580
vsFlexArray1.ColWidth(7) = 750
vsFlexArray1.ColWidth(8) = 600
vsFlexArray1.ColWidth(9) = 750
vsFlexArray1.RowHeight(0) = 600
vsFlexArray1.BackColorSel = RGB(100, 184, 150)
vsFlexArray1.BackColorBkg = RGB(110, 110, 110)
vsFlexArray1.ForeColorSel = &HFF&
vsFlexArray1.Rows = 2
For W = 1 To vsFlexArray1.Cols - 1
vsFlexArray1.TextMatrix(1, W) = ""
Next W
vsFlexArray1.BackColorFixed = &HFF&
vsFlexArray1.ForeColorFixed = &HFFFFFF
vsFlexArray1.CellFontBold = True '-Negrita
vsFlexArray1.TextMatrix(0, 0) = "Nº"
vsFlexArray1.TextMatrix(0, 1) = "ORDEN"
vsFlexArray1.TextMatrix(0, 2) = "LIN"
vsFlexArray1.TextMatrix(0, 3) = "CODIGO"
vsFlexArray1.TextMatrix(0, 4) = " PRODUCTO"
vsFlexArray1.TextMatrix(0, 5) = "ORD"
vsFlexArray1.TextMatrix(0, 6) = "ASIG"
vsFlexArray1.TextMatrix(0, 7) = "KIL.ASG"
vsFlexArray1.TextMatrix(0, 8) = "PICK"
vsFlexArray1.TextMatrix(0, 9) = "KIL.PICK"
End Sub

"carga el VSFLEXARRAY1"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FILAAA As Integer, FILaB As Integer
Dim ws1 As Worksheet
If ActiveCell.FormulaR1C1 = "Orden" Then
UserForm3.Show
UserForm3.Caption = " DETALLE: ORDEN DE VENTA"
UserForm3.vsFlexArray1.Rows = 1
With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set ws1 = Worksheets("ASG 61,10,2")

FILaB = 2
While ws1.Cells(FILaB, 10).Value <> ""
If ????????????? = ws1.Cells(FILaB, 11).Value Then
UserForm3.vsFlexArray1.RowHeight(FILAAA) = 270
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 1) = ws1.Cells(FILaB, 11).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 2) = ws1.Cells(FILaB, 17).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 3) = ws1.Cells(FILaB, 18).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 4) = ws1.Cells(FILaB, 19).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 5) = ws1.Cells(FILaB, 21).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 7) = ws1.Cells(FILaB, 22).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 6) = ws1.Cells(FILaB, 1).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 8) = ws1.Cells(FILaB, 23).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 9) = ws1.Cells(FILaB, 4).Value
UserForm3.vsFlexArray1.Rows = UserForm3.vsFlexArray1.Rows + 1
FILAAA = FILAAA + 1
End If
UserForm3.vsFlexArray1.CellForeColor = vbBlack
With UserForm3.vsFlexArray1
For X = 1 To .Rows - 1
.Col = 0
.Row = X
.Text = X
Next X
End With
FILaB = FILaB + 1
Wend
With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With
Set ws1 = Nothing
End If
End Sub

Atte.

Catita Zarate

Amigos:

¡Encontre la solucion...!. Asi como solicite ayuda, era logico que si encontraba la solucion debia publicarlo.

"carga el VSFLEXARRAY1"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ORD As Long, ASIG As Long, PICK As Long, FILAAA As Integer, FILaB As Integer, Z As Long, A As Long, B As Long, C As Long, D As Long
Dim ws1 As Worksheet, ws2 As Worksheet
If ActiveCell.FormulaR1C1 = "Orden" Then
UserForm3.Show
UserForm3.Caption = " DETALLE: ORDEN DE VENTA"
UserForm3.vsFlexArray1.Rows = 1
End If

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
If Not Intersect(Target, Range("B:B")) Is Nothing And Selection.Count = 1 And ActiveCell.FormulaR1C1 <> "Orden" Then
Set ws1 = Worksheets("ASG 61,10,2")
UserForm3.vsFlexArray1.Rows = 2
For Z = 1 To UserForm3.vsFlexArray1.Cols - 1
UserForm3.vsFlexArray1.TextMatrix(1, Z) = ""
Next Z
FILaB = 2
While ws1.Cells(FILaB, 10).Value <> ""
FILaB = FILaB + 1
Wend
A = 0
B = 0
C = 0
D = 0
FILAAA = 1
For FILA1 = 2 To FILaB
If Intersect(Target, Range("B:B")) = ws1.Cells(FILA1, 11).Value Then
UserForm3.vsFlexArray1.RowHeight(FILAAA) = 270
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 1) = ws1.Cells(FILA1, 11).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 2) = ws1.Cells(FILA1, 17).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 3) = ws1.Cells(FILA1, 18).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 4) = ws1.Cells(FILA1, 19).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 5) = ws1.Cells(FILA1, 21).Value
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 6) = ws1.Cells(FILA1, 22).Value
A = A + Val(UserForm3.vsFlexArray1.TextMatrix(FILAAA, 6))
UserForm3.vsFlexArray1.CellForeColor = vbBlue
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 7) = ws1.Cells(FILA1, 1).Value
B = B + Val(UserForm3.vsFlexArray1.TextMatrix(FILAAA, 7))
UserForm3.vsFlexArray1.CellForeColor = vbBlue
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 8) = ws1.Cells(FILA1, 23).Value
C = C + Val(UserForm3.vsFlexArray1.TextMatrix(FILAAA, 8))
UserForm3.vsFlexArray1.TextMatrix(FILAAA, 9) = ws1.Cells(FILA1, 4).Value
D = D + Val(UserForm3.vsFlexArray1.TextMatrix(FILAAA, 9))
UserForm3.vsFlexArray1.Rows = UserForm3.vsFlexArray1.Rows + 1
FILAAA = FILAAA + 1
End If
UserForm3.vsFlexArray1.CellForeColor = vbBlack
With UserForm3.vsFlexArray1
For X = 1 To .Rows - 1
.Col = 0
.Row = X
.Text = X
Next X
End With
UserForm3.TextBox4.Text = A
UserForm3.TextBox4.ForeColor = vbBlue
UserForm3.TextBox3.Text = B
UserForm3.TextBox3.ForeColor = vbBlue
UserForm3.TextBox2.Text = C
UserForm3.TextBox1.Text = D
Next FILA1
End If
With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With
Set ws1 = Nothing
End Sub

Pero tengo un detalle, me gustaria que el bucle sea mas rapido, espero que alguien me ayude a optimizarlo.

Atte.

Catita

si me envías el archivo y toda la info quizá pueda ayudarte a optimizar...

Saludos, desde Baires, JuanC

JuanC:

Hola, cual es tu correo para enviarte el archivo,,,?. Ojala no tenga problema en enviarte, porque el archivo es muy pesado.

Atte.

Catita

comprimilo al máximo con winrar o 7zip
[email protected]

Saludos, desde Baires, JuanC

Amigos:

Gracias a la ayuda de JuanC que optimizo el codigo para que el proceso sea mas rapido les envio el codigo

"cargar vsflexarray1"

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lFilaA&, lFilaB&, lFila1&
Dim Z&, A#, B#, C#, D#, old&, x&
Dim ws1 As Worksheet
Dim valor As Variant

If ActiveCell.FormulaR1C1 = "Orden" Then
UserForm3.Show
UserForm3.Left = (Application.ActiveWindow.Width - UserForm3.Width) / 2
UserForm3.Top = (Application.ActiveWindow.Height - UserForm3.Height) / 2
UserForm3.Caption = " DETALLE: ORDEN DE VENTA"
UserForm3.vsFlexArray1.Rows = 1
End If

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With

If Not Intersect(Target, Range("B:B")) Is Nothing And Selection.Count = 1 And ActiveCell.FormulaR1C1 <> "Orden" Then
Set ws1 = Worksheets("ASG 61,10,2")

With UserForm3.vsFlexArray1
.Rows = 2
For Z = 1 To .Cols - 1
.TextMatrix(1, Z) = ""
Next Z
End With

lFilaB = 2
While ws1.Cells(lFilaB, 10).Value <> ""
lFilaB = lFilaB + 1
Wend

A = 0#
B = 0#
C = 0#
D = 0#
lFilaA = 1

valor = Intersect(Target, Range("B:B")).Value

For lFila1 = 2 To lFilaB
If valor = ws1.Cells(lFila1, 11).Value Then
With UserForm3.vsFlexArray1
.RowHeight(lFilaA) = 270
.TextMatrix(lFilaA, 1) = ws1.Cells(lFila1, 11).Value
.TextMatrix(lFilaA, 2) = ws1.Cells(lFila1, 17).Value
.TextMatrix(lFilaA, 3) = ws1.Cells(lFila1, 18).Value
.TextMatrix(lFilaA, 4) = ws1.Cells(lFila1, 19).Value
.TextMatrix(lFilaA, 5) = ws1.Cells(lFila1, 21).Value
.TextMatrix(lFilaA, 6) = ws1.Cells(lFila1, 22).Value
.TextMatrix(lFilaA, 7) = ws1.Cells(lFila1, 1).Value
.TextMatrix(lFilaA, 8) = ws1.Cells(lFila1, 23).Value
.TextMatrix(lFilaA, 9) = ws1.Cells(lFila1, 4).Value

A = A + Val(Replace(.TextMatrix(lFilaA, 6), ",", "."))
B = B + Val(Replace(.TextMatrix(lFilaA, 7), ",", "."))
C = C + Val(Replace(.TextMatrix(lFilaA, 8), ",", "."))
D = D + Val(Replace(.TextMatrix(lFilaA, 9), ",", "."))

.Rows = .Rows + 1
lFilaA = lFilaA + 1
End With
End If
Next lFila1

UserForm3.vsFlexArray1.CellForeColor = vbBlack
With UserForm3.vsFlexArray1
For x = 1 To .Rows - 1
.Col = 0
.Row = x
.Text = x
Next x
End With

With UserForm3
.TextBox4.Text = A
.TextBox4.ForeColor = vbBlue
.TextBox3.Text = B
.TextBox3.ForeColor = vbBlue
.TextBox2.Text = C
.TextBox1.Text = D
End With
End If

With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With

Set ws1 = Nothing

End Sub

Atte.

Catita