Search code examples
arraysexcelvbaloopsautofilter

Find Array Values in Worksheet Column


I run through a list of names in an array and create a worksheet based on that name.

I want to run through a list of group numbers and see if they can be found in a worksheet column.
If found, I need the main worksheet, "DataSource" to be filtered by the group numbers and paste the filtered data into the newly created worksheets.

When I try to filter through the array of group numbers I get the error "Type Mismatch"(reference ln 41).

I'm also struggling with how to paste the filtered data into their designated worksheets without having to declare a variable name for each worksheet.

Sub Loops()

'Declare Variant Array for Sheet Names
Dim WSNames(1 To 3) As String
WSNames(1) = "NA"
WSNames(2) = "EU"
WSNames(3) = "APAC"

'Declare Variant to Hold Array Elements
Dim item As Variant

'Loop through entire array

For Each item In WSNames
'create a new worksheet using the sheet names in array
    Sheets.Add(After:=Sheets("DataSource")).Name = item
Next item

'Set Variables for Data WS
Dim DataWS As Worksheet
Dim GrpRge As Range
Dim DataRge As Range

Set DataWS = Worksheets("DataSource")
Set GrpRge = DataWS.Range("G2").EntireColumn

'Declare Variant Array for Group Numbers
Dim GrpNumbers(1 To 3) As Integer
GrpNumbers(1) = Array(18522, 20667)
GrpNumbers(2) = 18509
GrpNumbers(3)= 56788

'Declare Integer to Hold Array Elements
Dim i As Variant

'Filter Data Worksheets to Create Pivot Tables
For Each i In CCNumbers
    If i = GrpRge.Value Then Worksheets("DataSource").Range("G2").AutoFilter Field:=7, Criteria1:=i
    Set DataRge = Worksheets("DataSource").Range("As").CurrentRegion
    Worksheets("DataSource").Activate
    DataRge.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    WSNames.Range("A1").PasteSpecial Paste:=xlPasteAll
Next i

End Sub

Tried creating a For Loop but it won't run correctly.


Solution

  • Export Groups of Data

    Before

    enter image description here

    After

    enter image description here

    The Code

    Option Explicit
    
    Sub ExportGroups()
    
        ' Populate a String array with the worksheet names.
        Dim wsNames(1 To 3) As String
        wsNames(1) = "NA"
        wsNames(2) = "EU"
        wsNames(3) = "APAC"
    
        ' Populate a Variant array with the group numbers.
        Dim grpNumbers(1 To 3) As Variant
        grpNumbers(1) = Array("18522", "20667") ' use strings here!!!
        grpNumbers(2) = 18509
        grpNumbers(3) = 56788
        
        ' Turn off settings.
        Application.ScreenUpdating = False
        
        ' Reference the workbook.
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        ' Ensure the workbook is active because cells are being selected
        ' later in the code (e.g. 'dfCell.Select').
        If Not wb Is ActiveWorkbook Then wb.Activate
        
        ' Reference the Source worksheet, the one read (copied) from.
        Dim sws As Worksheet: Set sws = wb.Worksheets("DataSource")
        ' Turn off AutoFilter.
        If sws.AutoFilterMode Then sws.AutoFilterMode = False
        ' Reference the Source range.
        Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
        
        ' Declare additional variables.
        Dim dws As Worksheet ' Destination Worksheet (the one written (pasted) to)
        Dim dfCell As Range
        Dim n As Long ' Counter (For...Next Control Variable)
    
        ' Loop through the elements of the arrays.
        For n = UBound(wsNames) To LBound(wsNames) Step -1
        ' or:
        'For n = UBound(grpNumbers) To LBound(grpNumbers) Step -1
            ' Add a new worksheet (after the source worksheet)...
            Set dws = wb.Worksheets.Add(After:=sws)
            ' ... and rename it using the current name from the names array.
            dws.Name = wsNames(n)
            If IsArray(grpNumbers(n)) Then ' multiple group numbers (in an array)
                srg.AutoFilter 7, grpNumbers(n), xlFilterValues
            Else ' a single group number
                srg.AutoFilter 7, grpNumbers(n) ', 'xlAnd' is default (irrelevant)
            End If
            ' Reference the first destination cell.
            Set dfCell = dws.Range("A1")
            ' Copy column widths using the source's header row.
            srg.Rows(1).Copy
            dfCell.PasteSpecial xlPasteColumnWidths
            ' Select the first cell since now the selection is the first row,
            ' a by-product of 'PasteSpecial'.
            dfCell.Select
            ' Copy the visible range.
            srg.SpecialCells(xlCellTypeVisible).Copy dfCell
            ' Clear the filter.
            sws.ShowAllData
        Next n
        
        ' Turn off AutoFilter (out-comment to keep the auto filter arrows).
        sws.AutoFilterMode = False
        
        ' Select the first source cell.
        Application.Goto srg.Cells(1) ' includes activating the worksheet
    
        ' Turn on settings.
        Application.ScreenUpdating = True
        
        ' Inform.
        MsgBox "Data groups exported.", vbInformation
    
    End Sub