Split match array results into new worksheets

Hi there,

I've done some research and pulled together some code from other threads but a bit stuck now...

I'm trying to split some data based on two columns with criteria which one has a user input box. Then with the output array I need to split the results into new worksheets/workbooks based upon row count from another input box. New workbooks to be saved with sequential number order.

Kind regards

Option Explicit
Option Compare Text
  
Sub GetData()

Application.ScreenUpdating = False

MsgBox "Proceed?", vbOKCancel

Dim MainArr As Variant, DestArr As Variant, DMAValue As Variant
Dim LRow As Long, i As Long

DMAValue = InputBox("Please input the DMA number required (1-17).")
RowCount = InputBox("Please input the number of rows per spreadsheet.")

MainArr = ThisWorkbook.Sheets(2).Range("A2:H" & LR).Value
LRow = ThisWorkbook.Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

ReDim DestArr(1 To LRow)

For i = LBound(MainArr) To UBound(MainArr)
                                    
    If InStr(MainArr(i, 3), DMAValue) > 0 And InStr(MainArr(i, 4), "N") > 0 Then
    
'Split DestArr into a new Worksheet in a new Workbook each time, split by result of "RowCount" input box
'Paste ThisWorkbook.Sheet1.Range(A1:H1) header row into A1 of each new worksheet
'Paste DestArr split data into ThisWorkbook.Sheet1.Range into A2 of each new worksheet
'Filenames to be ThisWorkbook.Path & Application.Seperator & "DMA-" & DMA Value & 'spreadsheet number created by split 01,02 ,03 etc
'Saves changes and close each new workbook before creating next

MsgBox "Done"
  
Application.ScreenUpdating = True

End Sub

I am assuming the values in column C are numeric, not text. Your pseudo code above would not work for actual NUMERIC tests, only for text comparisons. If you search for 1 in a cell with a value 15, it will match using INSTR. So I did not use that.

If the column C values are actually text strings, we'll need to discuss exactly what those strings look like for all the 1-17 examples to be sure we get an accurate test.

Meanwhile, using straight numeric testing in column C, this seems to work.

Option Explicit
Option Compare Text
  
Sub GetData()
Dim MainArr As Variant, DestArr As Variant, wbOUT As Workbook
Dim LRow As Long, i As Long, o As Long, c As Long
Dim DMAValue As Long, RowCount As Long, FileNum As Long

Application.ScreenUpdating = False

If MsgBox("Proceed?", vbOKCancel) <> vbOK Then Exit Sub

DMAValue = Application.InputBox("Please input the DMA number required (1-17).", "DMA Value", 2, Type:=1)
RowCount = Application.InputBox("Please input the number of rows per spreadsheet.", "Rows Per Output File", 10, Type:=1)

With ThisWorkbook.Sheets(2)
    LRow = .Range("A" & Rows.Count).End(xlUp).Row
    MainArr = .Range("A2:H" & LRow).Value
End With

'create empty output array
ReDim DestArr(1 To RowCount, 1 To 8)

'prime the output row
o = 0

'fill in specific number of rows
For i = LBound(MainArr) To UBound(MainArr)
    If MainArr(i, 3) = DMAValue And InStr(MainArr(i, 4), "N") > 0 Then
        'increment next output row because we are about to write data now
        o = o + 1
        'add data to destarr in output row
        For c = 1 To 8
            DestArr(o, c) = MainArr(i, c)
        Next c
    End If
    'check if we are at the end of either array
    If (i = UBound(MainArr) Or o = UBound(DestArr)) Then
        'check if there is data to write out in the destarr
        If DestArr(2, 1) <> "" Then
            'increment the output filenum
            FileNum = FileNum + 1
            Set wbOUT = Workbooks.Add
            wbOUT.Sheets(1).Range("A2:H2").Resize(RowCount).Value = DestArr
            'add headers
            ThisWorkbook.Sheets(2).Range("A1:H1").Copy wbOUT.Sheets(1).Range("A1")
            ActiveSheet.Columns.AutoFit
            wbOUT.SaveAs ThisWorkbook.Path & Application.PathSeparator & "DMA-" & DMAValue & "-" & FileNum & ".xlsx", 51
            wbOUT.Close False
            
            'clear the destarr data
            ReDim DestArr(1 To RowCount, 1 To 8)
            'reset output tow to 1, we use row because we don't want to ever enter the loop on a datarow,
            'else the workbook will get written out before it is completely filled.
            o = 0
        End If
    End If
Next i

MsgBox "Done - a total of " & FileNum & " files were created for DMA value " & DMAValue
Application.ScreenUpdating = True

End Sub

That shouldn't be happening with my code above. I spoke of this and your original use of "INSTR()" method, I did not use that for Column C, I used an exact VALUE match. 10-17 are not matches to 1 so that shouldn't happen. I'd need to see what you're seeing.

On the off chance I uploaded the wrong last version, here it is again.