none
How to store a filtering data in an array in VBA? RRS feed

  • Question

  • I filter my data file on the basis of Status (that are filled and partially filled). The following data represents after filtering data . That is why, First row in here actually present in main data file is 336th rows, similarly, 2nd rows in here actual position in data file is 667th row. I would like to store them in an array and i can call them when necessary. 

    Second Question: i would like to use Time1 data as a 30 sec interval, i.e., [51:42.0-00:30.0, 51:42.0+00:30.0] for viewing all of the data from main data file. I would like to get some idea in VBA. 

    Time1  Symbol  Status  Price 

    51:42.0  SYH    Filed      0.405

    19:.27.0  PAC    Partially_Filled  0.43

    Wednesday, June 13, 2018 2:53 AM

All replies

  • It seems like your data is well structured.  One cool thing about Excel you can access it as a database using Oledb.  You can write SQL to extract the exact records you need.  SQL is very powerful.  I use it for Pivot tables and graphs.  Here is a good link that provides a tutorial.  Here is a good tutorial on using SQL with Excel (videos 71-93)
    Wednesday, June 13, 2018 1:03 PM
  • I would like to get some idea in VBA. 


    Get the visible cells from the Autofilter, e.g.:

    Function GetAutoFilterRange(Optional ByVal Parent As Object, _
        Optional WithoutHeader As Boolean = True) As Range
      'Returns the visible range of an Autofilter, Excel 2010 and above
      Dim R As Range
    
      If Parent Is Nothing Then
        Set Parent = ActiveSheet
        If Parent Is Nothing Then Exit Function
      End If
    
      'No filter, return nothing
      If TypeOf Parent Is Worksheet Then
        If Not Parent.AutoFilterMode Then Exit Function
      ElseIf TypeOf Parent Is ListObject Then
        If Parent.AutoFilter Is Nothing Then Exit Function
      Else
        Err.Raise 438, "GetAutoFilterRange", "Object " & TypeName(Parent) & " not supported"
      End If
      
      With Parent.AutoFilter
        'Get the whole range
        Set R = .Range
        'Remove headings?
        If WithoutHeader Then
          If R.Rows.Count = 1 Then Exit Function
          Set R = R.Resize(R.Rows.Count - 1).Offset(1)
        End If
        'Filter active?
        If .FilterMode Then
          'Error's off, we get an error if no cells are visible
          On Error GoTo ExitPoint
          Set R = R.SpecialCells(xlCellTypeVisible)
        End If
      End With
      'Return the result
      Set GetAutoFilterRange = R
    ExitPoint:
    End Function

    Then sum the number of rows in each area

      Set All = GetAutoFilterRange(Sheets(1))
      For Each Area In All.Areas
        k = k + Area.Rows.Count
      Next

    Create an 2D array with the number of rows and columns for all data
    Use the same loop and read in each area into an temp array
    Copy the temp array into the data array
    Done

    Andreas.

    ...

    Thursday, June 14, 2018 10:13 AM
  • Hi Andreas,

    Thanks for your good idea. Actually, I do not have much idea regarding using function in VBA. I would like to use of it in the simplest way:

    If you would not mind, could you please tell me, what is right way to get the visible filter data? (why not this provides right filter row information and how can i save of it in an array and i will use of it when necessary.

      Range("M2:M" & lastrow).SpecialCells(xlCellTypeVisible).Cells(1).Address)

    Sub FilledORPartiallyFiiled()

    Dim x As Workbook

    Dim finalrow As Long, lastrow As Long
     
    lastrow = ActiveWorkbook.Sheets(1).Range("L100000").End(xlUp).Row ' lastrow for new right side table

    'Set x = Workbooks.Open("C:/Users/trader3/Desktop/RaselBiswas/program/DataManipulation.xlsm")
     
    finalrow = ActiveWorkbook.Sheets(1).Range("J100000").End(xlUp).Row + 1 '  final row of a specfic columns

    Range("R1").Select
        
    Selection.AutoFilter
           
    Range("$L$1:$V$" & lastrow).AutoFilter Field:=7, Criteria1:="=FILLED" _
               , Operator:=xlOr, Criteria2:="=PARTIALLY_FILLED"
               
    'If ActiveSheet.FilterMode Then

    '   ActiveSheet.ShowAllData
        
    'End If

    'Selection.AutoFilter

    ' ------------- FILTER DONE -----------------------------

    rowNum = ActiveSheet.Range("M1").End(xlDown).Row

    Dim Array1(20000) As Variant

    colNum = 13 'column M

    Dim rsltRng As Range

    Dim VarRes As Double

    ' get only the filteres rows in column M

    Set rsltRng = ActiveWorkbook.Sheets(1).Range("M2:M" & rowNum).SpecialCells(xlCellTypeVisible)

    Dim dateValue As Variant

    dateValue = rsltRng.Value

    ' it gives me first visible row number after filtering, it works perfectly

    MsgBox Range("M2:M" & lastrow).SpecialCells(xlCellTypeVisible).Cells(1).Address

    ' print array values

    'Dim i As Integer

    'Debug.Print "i", "j", "Value"

    'For i = 2 To 5

    'result = ActiveSheet.Cells(i, colNum).Text

    'Next

    'Debug.Print result



    'Dim i As Long, j As Long
     '   For i = LBound(dateValue) To UBound(dateValue)
      '      For j = LBound(dateValue, 2) To UBound(dateValue, 2)
      '          Debug.Print i, j, dateValue(i, j)
       '     Next j
        ' Next i

    'Debug.Print result

    ' Filtering on the basis of time range

    strStartTime = "00:24.8"

    strEndTime = "12:33:05"


    Range("M1").Select
        
    Selection.AutoFilter

    'ActiveSheet.Range("$L$1:$U$1301").AutoFilter Field:=2, Criteria1:="00:24.8"
        
    ActiveSheet.Range("$L$1:$U$1301").AutoFilter Field:=2, Criteria1:= _
            "=00:24.8", Operator:=xlOr, Criteria2:="=00:37.7"
     
    End Sub



    Friday, June 15, 2018 8:47 PM
  • Option Explicit
    
    Dim Cache As Variant
    
    Sub Main()
      Dim All As Range, Area As Range
      Dim i As Long, j As Long, k As Long
      Dim Temp
      
      'Get all visible cells
      Set All = GetAutoFilterRange(ActiveSheet)
      If All Is Nothing Then
        MsgBox "No Cache, all rows filtered"
        Exit Sub
      End If
      'Determine the number of rows and columns
      j = All.Columns.Count
      For Each Area In All.Areas
        k = k + Area.Rows.Count
      Next
      'Allocate space for the data
      ReDim Cache(1 To k, 1 To j)
      k = 0
      For Each Area In All.Areas
        'Read in all values from this area
        Temp = Area.Value
        'In case of a single cell we have to create the array
        If Not IsArray(Temp) Then
          ReDim Temp(1 To 1, 1 To 1)
          Temp(1, 1) = Area.Value
        End If
        'Copy this part into the cache
        For j = 1 To UBound(Temp, 2)
          For i = 1 To UBound(Temp)
            Cache(k + i, j) = Temp(i, j)
          Next
        Next
        k = k + UBound(Temp)
      Next
    End Sub
    
    Private Function GetAutoFilterRange(Optional ByVal Parent As Object, _
        Optional WithoutHeader As Boolean = True) As Range
      'Returns the visible range of an Autofilter, Excel 2010 and above
      Dim R As Range
    
      If Parent Is Nothing Then
        Set Parent = ActiveSheet
        If Parent Is Nothing Then Exit Function
      End If
    
      'No filter, return nothing
      If TypeOf Parent Is Worksheet Then
        If Not Parent.AutoFilterMode Then Exit Function
      ElseIf TypeOf Parent Is ListObject Then
        If Parent.AutoFilter Is Nothing Then Exit Function
      Else
        Err.Raise 438, "GetAutoFilterRange", "Object " & TypeName(Parent) & " not supported"
      End If
      
      With Parent.AutoFilter
        'Get the whole range
        Set R = .Range
        'Remove headings?
        If WithoutHeader Then
          If R.Rows.Count = 1 Then Exit Function
          Set R = R.Resize(R.Rows.Count - 1).Offset(1)
        End If
        'Filter active?
        If .FilterMode Then
          'Error's off, we get an error if no cells are visible
          On Error GoTo ExitPoint
          Set R = R.SpecialCells(xlCellTypeVisible)
        End If
      End With
      'Return the result
      Set GetAutoFilterRange = R
    ExitPoint:
    End Function
    
    

    ...

    Saturday, June 16, 2018 10:30 AM
  • Hi All,

    Thanks all of your ideas. I have done my problem.

    Friday, June 22, 2018 2:02 PM