Create an array for filtered and non-contiguous columns

Hello everyone
I have in my file filtered data based on column G

I need to create an array of the values of these filtered data for two columns (B & G) only

In other word to store the values of these two filtered columns (visible rows only) not all the values

Hi,

I gave you what you asked for, but also added what you probably need instead:
a. You asked for a two dimensional array
b. I think you need a one dimensional data structure which contains the two columns.

Notice that the array is rather cryptic, because you have to rely on the index numbers to determine whether you have an Item or a Mount (Amount). With the data structure you know right away. Of course, you could declare constants for each of the array indices that indicate 'Item' or 'Mount.

The difference is (simplified non-working examples)

'Array:
Dim vArray(1 to 2, 1 to 15) as Variant
vArray(1,1) = contents of row 4 column 'B'
vArray(2,1) = contents of row 4 column 'G'

'Data Structure
Public Type myStructure   'This must be at the top of the module
  sItemName As String
  iMount As Long              'your spreadsheet says Mount, you probably mean Amount
End Type

dim myStructureArray(1 to 15) as myStructure   
myStructureArray(1).sItemName = contents of row 4 column 'B'
myStructureArray(1).iMount = contents of row 4 column 'G'

Actual working code in an ordinary code module such as Module1:

Option Explicit

Public Type myStructure
  sItemName As String
  iMount As Long
End Type


Sub TestCreateStructureArrayOfFilteredData()

  Dim ws As Worksheet
  Dim myStructureArray() As myStructure

  Dim i As Long
  
  'Create the Worksheet Object
  Set ws = Sheets("Store")
  
  'Create an Array of Filtered Data
  Call CreateStructureArrayOfFilteredData(ws, myStructureArray)

  'Output the array contents in the Immediate Window (CTRL G in the debugger)
  Debug.Print "myStructureArray output created on " & Now()
  For i = LBound(myStructureArray) To UBound(myStructureArray)
    Debug.Print i, myStructureArray(i).sItemName, myStructureArray(i).iMount
  Next i
  
  'Clear object pointers
  Set ws = Nothing

End Sub

Sub CreateStructureArrayOfFilteredData(ws As Worksheet, myStructureArray() As myStructure)
  'This puts the contents of Columns 'B' and 'G' in a Structure Array
  '
  'The first data row is row 4
  
  Const nFirstDataROW = 4
  
  Dim vB As Variant
  Dim vG As Variant
  Dim iLastIndex As Long
  Dim iRow As Long
  Dim iLastDataRow As Long
  
  'Get the Last Data Row
  iLastDataRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
  ReDim myStructureArray(1 To 1)
  iLastIndex = 0
  
  For iRow = nFirstDataROW To iLastDataRow
  
    If ws.Rows(iRow).EntireRow.Hidden = False Then
      vB = ws.Cells(iRow, "B").Value
      vG = ws.Cells(iRow, "G").Value
      
      iLastIndex = iLastIndex + 1
      ReDim Preserve myStructureArray(1 To iLastIndex)
      myStructureArray(iLastIndex).sItemName = CStr(vB)
      myStructureArray(iLastIndex).iMount = CLng(vG)
    End If
  
  Next iRow
  

End Sub

Sub TestCreateArrayOfFilteredData()
  'Test Routine to Create a 2 dimensional Array of Variant data

  Dim ws As Worksheet
  Dim vArray As Variant

  Dim i As Long
  
  'Create the Worksheet Object
  Set ws = Sheets("Store")
  
  'Create an Array of Filtered Data
  Call CreateArrayOfFilteredData(ws, vArray)

  'Output the array contents in the Immediate Window (CTRL G in the debugger)
  Debug.Print "vArray output created on " & Now()
  For i = LBound(vArray, 2) To UBound(vArray, 2)
    Debug.Print i, vArray(1, i), vArray(2, i)
  Next i
  
  'Clear object pointers
  Set ws = Nothing

End Sub

Sub CreateArrayOfFilteredData(ws As Worksheet, vArray As Variant)
  'Routine to Create a 2 dimensional Array of Variant data
  '
  'This puts the contents of Column 'B' visible rows only in vArray(1,n)
  'This puts the contents of Column 'G' visible rows only in vArray(2,n)
  '
  'The first data row is row 4
  
  Const nFirstDataROW = 4
  
  Dim vB As Variant
  Dim vG As Variant
  Dim iLastIndex As Long
  Dim iRow As Long
  Dim iLastDataRow As Long
  
  'Get the Last Data Row
  iLastDataRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
  ReDim vArray(1 To 2, 1 To 1)
  iLastIndex = 0
  
  For iRow = nFirstDataROW To iLastDataRow
  
    If ws.Rows(iRow).EntireRow.Hidden = False Then
      vB = ws.Cells(iRow, "B").Value
      vG = ws.Cells(iRow, "G").Value
      
      iLastIndex = iLastIndex + 1
      ReDim Preserve vArray(1 To 2, 1 To iLastIndex)
      vArray(1, iLastIndex) = vB
      vArray(2, iLastIndex) = vG
    End If
  
  Next iRow
  
End Sub

Lewis

Thanks a lot mr. Lewis for this perfect way ..
It is excellent but I didn't imagine it would be so long way.
The two ways are wonderful ..

Is there an easy way to create UDF function that deal with arrays and we as beginner users use the UDF to have the results quickly?
I imagine this : CreateFilteredArray(WholeRangeOfData,Column B,Column G)
=CreateFilteredArray(Range("A4:G92"),2,7)

Thanks for your great and awesome help

@ cyiangou
Amazing UDF fuction. I consider it very useful too that can save time and effort
Thanks a lot for this great and wonderful gift

Just a little modification if possible ... the first parameter to be more spefici that's :
Worksheets("Sheet1").range("A3:G3")

v = GetFilteredArray(Worksheets("Sheet1").Range("A3:G3"), 2, 7)

Range("A3:G3") is the title header of the filtered range
Thanks alot for this great help

I noticed that there is a reference "Microsoft Forms 2.0 Object Library" and I tried to check it to activate it in my file but I didn't find the reference.
I'm using office 2013

It works well with your attachment
After copying the code to my file ,I got error "user-defined type not defined" Compile error
Any idea about that

Thanks .. I could fix it ..
I just need a little modification >> Just to add a line that checks auto filter mode .. if it is true then the code to be executed but if it is false to exit sub

Thanks everyone
I have added this line to solve the problem

If Worksheets("Store").FilterMode = False Then Exit Sub

Thanks a lot for any help me even if with a simple idea

I clicked Browse to add the reference and browse in system32 folder for FM20.DLL and add it
I get rid of the error "User-Defined type not defined"

After that I tested the code again and I got the following error

FilterSheet.AutoFilter.Range.copy

Object variable or with block variable not set

Any idea

Thanks for the rep points YasserKhalil.

YasserKhalil wrote:
Is there an easy way to create UDF function that deal with arrays and we as beginner users use the UDF to have the results quickly? I imagine this : CreateFilteredArray(WholeRangeOfData,Column B,Column G)
=CreateFilteredArray(Range("A4:G92"),2,7)

The function you want can not be used in a formula (see the next post for reasons):

=CreateFilteredArray(Range("A4:G92"),2,7)   'This is NOT ALLOWED

Try the following function (a slight modification of function CreateStructureArrayOfFilteredData() in post #2 above, which can be used in other VBA code. All the code that follows can be tested using the data from the file in post #2 above.

Function CreateFilteredArray(myRange As Range, iColumn1 As Long, iColumn2 As Long) As Variant
  'This returns a variant two dimensional array containing data from the input range, but
  'only using data from the input columns (visible rows only)

  Dim r1 As Range
  Dim r2 As Range
  Dim vArray As Variant
  Dim v1 As Variant
  Dim v2 As Variant
  Dim iLastIndex As Long
  Dim iRow As Long
  Dim iFirstDataRow As Long
  Dim iLastDataRow As Long
  
  'Get the First and Last Data Rows
  iFirstDataRow = myRange.Row
  iLastDataRow = iFirstDataRow + myRange.Rows.Count - 1
  
  'Verify that the input columns are in the Input Range
  Set r1 = Intersect(myRange, Columns(iColumn1))
  Set r2 = Intersect(myRange, Columns(iColumn2))
  
  'Exit if 'iColumn1' is NOT in 'myRange'
  If r1 Is Nothing Then
    GoTo MYEXIT
  End If
  
  'Exit if 'iColumn2' is NOT in 'myRange'
  If r2 Is Nothing Then
    GoTo MYEXIT
  End If
  
  
  'Initialize the Variant array
  ReDim vArray(1 To 2, 1 To 1)
  iLastIndex = 0
  
  'Create the Variant Array
  For iRow = iFirstDataRow To iLastDataRow
  
    'Get the address where the current row and the current column intersects
    Set r1 = Intersect(myRange, Rows(iRow), Columns(iColumn1))
    Set r2 = Intersect(myRange, Rows(iRow), Columns(iColumn2))
  
    'Process the row if it is visible
    If r1.EntireRow.Hidden = False Then
    
      'Get the value for each column in the current row
      v1 = r1.Value
      v2 = r2.Value
      
      'Add the value to the Variant array
      iLastIndex = iLastIndex + 1
      ReDim Preserve vArray(1 To 2, 1 To iLastIndex)
      vArray(1, iLastIndex) = v1
      vArray(2, iLastIndex) = v2
      
    End If
  
  Next iRow
  
  'Clear object pointers
  Set r1 = Nothing
  Set r2 = Nothing
  
MYEXIT:

  'Create the return array to be used by the calling routine
  CreateFilteredArray = vArray

End Function

The following are a few ways to test the above function.

Sub TestCreateFilteredArray()
  'Test Routine to Create a 2 dimensional Array of Variant data

  Dim myRange As Range
  Dim vArray As Variant

  Dim i As Long
  
  ''''''''''''''''''''''''''''''''''''''''''''
  'Bad Input Column Number Example
  ''''''''''''''''''''''''''''''''''''''''''''
  vArray = CreateFilteredArray(Sheets("Store").Range("A4:G90"), 2, 22)
  'Output the array contents in the Immediate Window (CTRL G in the debugger)
  Debug.Print "vArray output created on " & Now()
  If IsEmpty(vArray) = True Then
    Debug.Print "CreateFilteredArray() had bad input data - vArray is EMPTY."
  Else
    For i = LBound(vArray, 2) To UBound(vArray, 2)
      Debug.Print i, vArray(1, i), vArray(2, i)
    Next i
  End If
  Debug.Print


  ''''''''''''''''''''''''''''''''''''''''''''
  'Create an Array of Valid Filtered Data Example (Explicit Range as Formal Parameter)
  ''''''''''''''''''''''''''''''''''''''''''''
  vArray = CreateFilteredArray(Sheets("Store").Range("A4:G90"), 2, 7)

  'Output the array contents in the Immediate Window (CTRL G in the debugger)
  Debug.Print "vArray output created on " & Now()
  If IsEmpty(vArray) = True Then
    Debug.Print "CreateFilteredArray() had bad input data - vArray is EMPTY."
  Else
    For i = LBound(vArray, 2) To UBound(vArray, 2)
      Debug.Print i, vArray(1, i), vArray(2, i)
    Next i
  End If
  Debug.Print
  
  
  
  ''''''''''''''''''''''''''''''''''''''''''''
  'Create an Array of Valid Filtered Data Example (Range Object as Formal Parameter)
  ''''''''''''''''''''''''''''''''''''''''''''
  Set myRange = Sheets("Store").Range("A4:G60")
  vArray = CreateFilteredArray(myRange, 2, 7)

  'Output the array contents in the Immediate Window (CTRL G in the debugger)
  Debug.Print "vArray output created on " & Now()
  If IsEmpty(vArray) = True Then
    Debug.Print "CreateFilteredArray() had bad input data - vArray is EMPTY."
  Else
    For i = LBound(vArray, 2) To UBound(vArray, 2)
      Debug.Print i, vArray(1, i), vArray(2, i)
    Next i
  End If
  Debug.Print
    
  
  'Clear object pointers
  Set myRange = Nothing

End Sub

Lewis

Just FYI, you can late bind that function from cyiangou so you don't need the MS Forms reference each time:

Public Function GetFilteredArray(FilterSheet As Excel.Worksheet, ParamArray ColIndex()) As Variant
    'ColIndex - list of column indexes you want returned, 1=first col
    Dim DataObj As Object
    Dim Rows As Variant, Cols As Variant
    Dim r  As Long, c As Long, v As Variant
    FilterSheet.AutoFilter.Range.Copy
    Set DataObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    DataObj.GetFromClipboard
    Rows = Split(DataObj.GetText, vbCrLf)
    DataObj.Clear
    ReDim v(0 To UBound(Rows), 0 To UBound(ColIndex))
    For r = 0 To UBound(Rows)
        If Rows(r) = "" Then Exit For
        Cols = Split(Rows(r), vbTab)
        For c = 0 To UBound(ColIndex)
            v(r, c) = Cols(ColIndex(c) - 1)
        Next c
    Next r
    GetFilteredArray = v
End Function

Just for completeness, it is possible to work around b, c and d and enable a UDF to do pretty much anything a Sub can do, but it's complicated (either requiring Windows timers or using event code as well) and not usually a good idea.