Excel VBA to pass Autofilter visible cells to Variant

[Biz]

Dear All,

Currently I am having problems with my macro as it fails to capture visible cells as array values.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

If I use myVRng.address then I get B528:B554, B728:B1053, B2123:B2500 but really B528:B524 and B738:B1053.<o></o>
It only captures first lot as 27 cells (B528:B554).<o></o>

I believe problem is because NonContiguous range.<o></o>
<o> </o>
Is there a way to fix this problem?

<o>

Option Explicit
Option Base 1
Option Compare Text</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>Dim ws As Worksheet</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>Sub Main()
Dim rCells As Range, jRange As Range, tRange As Range, myVRng As Range
Dim jLR As Long, tLR As Long
Dim myarray As Variant, aCell As Variant, aStartTime
Dim i As Integer</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>'Speeding Up VBA Code
Application.ScreenUpdating = False 'Prevent screen flickering
Application.Calculation = xlCalculationManual 'Preventing calculation
Application.DisplayAlerts = False 'Turn OFF alerts
Application.EnableEvents = False 'Prevent All Events</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>'Start Timer
aStartTime = Now()
 
Call uUnProtect</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>'Removes AutoFilter if one exists
 Worksheets("JobCodes").AutoFilterMode = False
    
'Add AutoFilter with a criteria
Worksheets("JobCodes").ListObjects("Table_KILO_FinTool_l_Job").Range.AutoFilter Field:=2 _
        , Criteria1:=Array("38130", "38145", "38150", "38155", "38160", "38165", "38170", "38175", "38180", "38185"), Operator:=xlFilterValues
 '<<<====Change Required</o:p>[/SIZE][/FONT][/COLOR]
[COLOR=black][FONT=Calibri][SIZE=3]<o:p>
jLR = Range("aaTopJR").Parent.Cells(Rows.Count, Range("aaTopJR").Column).End(xlUp).Row
tLR = Range("tTopJobNo").Parent.Cells(Rows.Count, Range("tTopJobNo").Column).End(xlUp).Row
Set jRange = Sheets("JobCodes").Range("B2:B" & jLR)
Set tRange = Sheets("Input").Range("B7:B" & tLR)
'Derived Visible Range from Jobcodes Tab
With Worksheets("JobCodes")
    With .AutoFilter.Range
        If .Columns(3).Cells.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
        'do nothing, only the header is visible
    Else
        'go to column 3 (C) and come down a row and subtract a row to ignore the header
        'Rows.count-1 to get last visible cell with data
        'Offset (1,-2) to go back to column B
        Set myVRng = .Columns(3).Resize(.Rows.Count - 1, 1).Offset(1, -2) _
         .Cells.SpecialCells(xlCellTypeVisible)
        End If
    End With
End With
'Process Ranges using Arrays
myarray = myVRng.Value
'Looping structure to look at array.
    For i = 1 To UBound(myarray)
        'MsgBox myarray(i, 1)
        aCell = Application.VLookup(myarray(i, 1), tRange, 1, 0)
        If IsError(aCell) Then
            If IsEmpty(Range("B7")) Then
                Sheets("Input").Cells(65536, Range("B7").Column).End(xlUp).Value = myarray(i, 1) 'if only values are needed: Destination.value=Target.value
            Else
                Sheets("Input").Cells(65536, Range("B6").Column).End(xlUp).Offset(1, 0).Value = myarray(i, 1) 'if only values are needed: Destination.value=Target.value
            End If
        End If
    Next i
 
'Speeding Up VBA Code
Application.ScreenUpdating = True 'Prevent screen flickering
Application.Calculation = xlAutomatic 'Preventing calculation
Application.DisplayAlerts = True 'Turn OFF alerts
Application.EnableEvents = True 'Prevent All Events
 
Call uProtect
 
'Release memory
    Set jRange = Nothing
    Set tRange = Nothing
 
'End Timer
MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss"), vbInformation, "Complete"
 
End Sub

</o>


Any help would greatly appreciated?

Biz

 

[Richard Schollar]

Hi

You could generate your own variant array based on the size of the range:

Dim vArr As Variant
Dim i As Long, j As Long, rowCnt As Long
Dim r As Range, ar As Range
 
With ActiveSheet.AutoFilter.Range
    Set r = .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
End With
 
'this next bit creates your variant array just from visible cells:
ReDim vArr(1 To r.Count / r.Areas(1).Columns.Count, 1 To r.Areas(1).Columns.Count)
rowCnt = 1
For Each ar In r.Areas
    For i = 1 To ar.Rows.Count
        For j = 1 To ar.Columns.Count
            vArr(rowCnt, j) = ar.Cells(i, j)
        Next j
        rowCnt = rowCnt + 1
    Next i
Next ar
 
'now do something with your array:
Worksheets("SomeSHeet").Range("A1").Resize(UBound(vArr, 1), UBound(vArr, 2)) = vArr

 

[Sandeep Warrier]

Hi,

Because of the non-contiguous range, I don't think you'll be able to assign the range to the array directly. You'll probably have to use a For/Next loop.

For example:

'.
'.
'.
    ReDim myarray(1 To myVRng.Cells.Count)
    
    For Counter = 1 To myVRng.Cells.Count
        myarray(Counter) = myVRng.Cells(Counter, 1)
    Next Counter

'.
'.
'.

 

[Biz]

Hi Richard/Sandeep,

Thank you very much for your suggestion. If I have still questions regarding this matter then I would post again.

Kind Regards,

Biz

 

[Biz]

Hi Guys

I tried but unfortunately it does not work.

My code well still can't loop and get only

'Populating Array with visible values from Autofilter
aCount = Application.Subtotal(103, myVRng)
Debug.Print aCount
ReDim myarray(aCount)
    
    For i = 1 To aCount
        myarray(i) = myVRng.SpecialCells(xlCellTypeVisible).Cells(i)
    Next i

After first 27 rows it get 28th row value which is invisible.

Is there a way to fix this problem?

Thanks

Biz

 

[Biz]

Hi Guys,

Figured it out code. I have pasted below the changes. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

'Populating Array with visible values from Autofilter<o></o>
aCount = Application.Subtotal(103, myVRng)<o></o>
Debug.Print aCount<o></o>
ReDim myarray(aCount)<o></o>
<o></o>
v = 1<o></o>
For Each rCells In myVRng<o></o>
If v = aCount + 1 Then Exit For<o></o>
myarray(v) = rCells.Value<o></o>
v = v + 1<o></o>
Next rCells<o></o>


If you can think of better approach please let me know.<o></o>
Need to go for lunch now.<o></o>


Biz