Capturing data between header rows based on a variable - vba

Question

I'm having difficulty looping through rows of data between header rows to extract information and then sum the data from a few of the columns below the header row until it reaches the next header row. I am by no means a VBA expert vut Im trying to figure this out on my own and I've stripped down the code to just the basics trying to get this portion to work properly. I'm not sure if I'm taking the right approach to this, but I'm importing the data from the "Raw Data" worksheet into an array ("rdA", currently working fine), then trying to put the header data I need into one temporary array ("rdB", works for the first line, then gives an "Out of Range error) and information from the data rows below it into another temporary array ("rdC") so that I can try to sum data and add the sums to the first temporary array.
The header row always starts with [StartIspn] and I need to extract specific data from the header row (time stamp, user ID, and side). I then need to sum data from a few columns of the rows below, but only for the rows that contain "A13" in column E. The sample image below shows what the raw data looks like. The top gray header row is just in this example to define the columns of data between the headers. My thoughts are that this needs to be loops inside of loops to gather and sum the necessary data, but I'm currently getting stuck trying to get the data to go into the temp arrays. My end goal is to create an array that contains Wafer S/N (column B of rows between headers), Time Stamp, User ID, Wafer Side (all from each header row), and the sum of column F, sum of column H, Min of column I and Max of column J for all rows containing "A13" in column 6 between header rows.
If I can at least get some guidance as to whether or not the approach I'm using is wrong, and how to get past the out of range error when trying to add data to the temporary arrays, I'd be grateful.
Here's what I have so far:
' Define that arrays start with index 1 instead of 0
Option Base 1
' Define that variables must be defined manually and will never be defined automatically
Option Explicit
Sub Create_Report()
' Define variable names and types
Dim chkAnn As String ' Check column 5 for inspection type (A13)
Dim chkHdr As String ' Check column 2 for StartIspn or S/N
Dim fmTot As String ' Sum the total FM area per inspection
Dim fmNum As Long ' Sum the total number of FM particles per inspection
Dim fmMin As Long ' Find the min FM particle size per inspection
Dim fmMax As Long ' Find the max FM particle size per inspection
Dim h As Long ' Row count for FM data
Dim i As Long ' Row count of number of rows being processed
Dim idCol As String ' Time stamp from raw data header line
Dim idPos As Long ' Position of time stamp in raw data header cell
Dim idVal As String ' Time stamp from ecah inspection
Dim j As Long ' Row count for report data array
Dim k As Long ' Row count for debug print
Dim lRow As Long ' Count of number of rows in Raw Data
Dim m As Long ' Row count for debug print
Dim tsCol As String ' Time stamp from raw data header line
Dim tsPos As Long ' Position of time stamp in raw data header cell
Dim tsVal As String ' Time stamp from ecah inspection
Dim rdA() As Variant ' Array of imported Raw Data for parsing
Dim rdB() As Variant ' Array of processed data for report output
Dim rdC() As Variant ' Temp array of FM totals
Dim wfrSN As String ' Wafer serial number from line below header row
Dim wsCol As String ' Time stamp from raw data header line
Dim wsPos As Long ' Position of time stamp in raw data header cell
Dim wsVal As String ' Time stamp from ecah inspection
' Clear all arrays and variables in case report is run again
Erase rdA
ReDim rdA(1, 1)
Erase rdB
ReDim rdB(1, 1)
h = 0
i = 0
j = 0
k = 0
' Find number of populated rows in Raw Data
lRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
' Create array of data from "Raw Data" worksheet
rdA = Worksheets("Raw Data").Range("A1:Q1").Resize(lRow, 17).Value2
' PER INSPECTION GROUP
' Check each line of raw data and extract required info from header row
j = 1
For i = LBound(rdA, 1) To UBound(rdA, 1)
chkHdr = rdA(i, 2)
chkAnn = rdA(i, 5)
Const Hdr = "[StartIspn]"
' Check row for [StartIspn] in rdA Col 2
If InStr(1, chkHdr, Hdr, vbBinaryCompare) > 0 Then
' Collect Wafer Serial Number from next row and add to report array
wfrSN = rdA(i + 1, 2)
rdB(j, 1) = wfrSN
' Collect Time Stamp of inspections and add to report array
tsCol = rdA(i, 3)
tsPos = InStrRev(tsCol, "=")
tsVal = Mid$(tsCol, tsPos + 1)
rdB(j, 2) = tsVal
' Collect User ID and add to report array
idCol = rdA(i, 4)
idPos = InStrRev(idCol, "=")
idVal = Mid$(idCol, idPos + 1)
rdB(j, 3) = idVal
' Collect Wafer Side and add to report array
wsCol = rdA(i, 6)
wsPos = InStrRev(wsCol, "=")
wsVal = Mid$(wsCol, wsPos + 1)
If wsVal = "T" Then
wsVal = "Front"
ElseIf wsVal = "B" Then
wsVal = "Back"
End If
rdB(j, 4) = wsVal
' Resize the report array for the next data set
If j > 0 Then
ReDim Preserve rdB(j - 1)
End If
' Advance to next line in report array (rdB)
j = j + 1
Else
For h = LBound(rdA, 1) To UBound(rdA, 1)
chkAnn = rdA(h, 5)
Const Ann = "A13"
If InStr(1, chkAnn, Ann, vbBinaryCompare) > 0 Then
'Collect Wafer Serial Number
wfrSN = rdA(i, 2)
rdC(h, 1) = wfrSN
' Collect FM Total
fmTot = rdA(i, 6)
rdC(h, 2) = fmTot
' Collect # of FM Particles
fmNum = rdA(i, 8)
rdC(h, 3) = fmNum
' Collect Min Particle Size
fmMin = rdA(i, 9)
rdC(h, 4) = fmMin
' Collect Max Particle Size
fmMax = rdA(i, 10)
rdC(h, 5) = fmMax
' Advance to next line in temp array (rdC)
h = h + 1
End If
Next h
Next i
For k = LBound(rdB, 1) To UBound(rdB, 1)
Debug.Print rdB(k, 1) & ", " & _
rdB(k, 2) & ", " & _
rdB(k, 3) & ", " & _
rdB(k, 4)
Next k
For m = LBound(rdC, 1) To UBound(rdC, 1)
Debug.Print rdC(m, 1) & ", " & _
rdC(m, 2) & ", " & _
rdC(m, 3) & ", " & _
rdC(m, 4) & ", " & _
rdC(m, 5)
Next m
End Sub
Updated and working Code:
Sub Create_Report()
Dim vDB, vResult(), vSum1(), vSum2(), vMin(), vMax()
Dim Ws As Worksheet, wsResult As Worksheet
Dim s As String, i As Long, n As Long, r As Long
Dim k As Integer
Const Hdr = "[StartIspn]"
Const Ann = "A13"
Set Ws = Sheets("Raw Data")
Set wsResult = Sheets("AOI Inspection Summary")
vDB = Ws.Range("a1").CurrentRegion
r = UBound(vDB, 1)
For i = 1 To r
If InStr(vDB(i, 2), Hdr) Then
n = n + 1
ReDim Preserve vResult(1 To 9, 1 To n)
vResult(1, n) = n
vResult(2, n) = vDB(i + 1, 2)
vResult(3, n) = Replace(vDB(i, 3), "Time=", "")
vResult(4, n) = Replace(vDB(i, 4), "User=", "")
s = Replace(vDB(i, 6), "Side=", "")
If s = "T" Then
vResult(5, n) = "Front"
Else
vResult(5, n) = "Back"
End If
If k > 0 Then
vResult(6, n - 1) = WorksheetFunction.Sum(vSum1)
vResult(7, n - 1) = WorksheetFunction.Sum(vSum2)
vResult(8, n - 1) = WorksheetFunction.Min(vMin)
vResult(9, n - 1) = WorksheetFunction.Max(vMax)
k = 0
End If
Else
If InStr(vDB(i, 5), Ann) Then
k = k + 1
ReDim Preserve vSum1(1 To k)
ReDim Preserve vSum2(1 To k)
ReDim Preserve vMin(1 To k)
ReDim Preserve vMax(1 To k)
vSum1(k) = vDB(i, 6)
vSum2(k) = vDB(i, 8)
vMin(k) = vDB(i, 9)
vMax(k) = vDB(i, 10)
End If
End If
Next i
vResult(6, n) = WorksheetFunction.Sum(vSum1)
vResult(7, n) = WorksheetFunction.Sum(vSum2)
vResult(8, n) = WorksheetFunction.Min(vMin)
vResult(9, n) = WorksheetFunction.Max(vMax)
With wsResult 'array Result write on sheet
.Range("b21").CurrentRegion.Offset(2).ClearContents
.Range("b23").Resize(n, 9) = WorksheetFunction.Transpose(vResult)
End With
End Sub

Answer 1

Try this.
Sub test()
Dim vDB, vResult(), vSum(), vMin(), vMax()
Dim Ws As Worksheet, wsResult As Worksheet
Dim s As String, i As Long, n As Long, r As Long
Dim k As Integer
Const Hdr = "[StartIspn]"
Set Ws = Sheets("Raw Data")
Set wsResult = Sheets("AOI Inspection Summary")
vDB = Ws.Range("a1").CurrentRegion
r = UBound(vDB, 1)
For i = 2 To r '<~~ if your Raw data row 1 data is Row#, Watar S/n.... i start 2 else 1
If InStr(vDB(i, 2), Hdr) Then
n = n + 1
ReDim Preserve vResult(1 To 9, 1 To n)
vResult(1, n) = n
vResult(2, n) = vDB(i + 1, 2)
vResult(3, n) = Replace(vDB(i, 3), "Time=", "") 'time
vResult(4, n) = Replace(vDB(i, 4), "User=", "") 'Positon
s = Replace(vDB(i, 6), "Sided=", "")
If s = "T" Then
vResult(5, n) = "Front"
Else
vResult(5, n) = "Back"
End If
If k > 0 Then
vResult(6, n - 1) = WorksheetFunction.Sum(vSum)
vResult(7, n - 1) = 37 '<~~ what mean # of particle
vResult(8, n - 1) = WorksheetFunction.Min(vMin)
vResult(9, n - 1) = WorksheetFunction.Max(vMax)
k = 0
End If
Else
k = k + 1
ReDim Preserve vSum(1 To k)
ReDim Preserve vMin(1 To k)
ReDim Preserve vMax(1 To k)
vSum(k) = vDB(i, 6)
vMin(k) = vDB(i, 9)
vMax(k) = vDB(i, 10)
End If
Next i
vResult(6, n) = WorksheetFunction.Sum(vSum)
vResult(7, n) = 37 '<~~ what mean # of particle
vResult(8, n) = WorksheetFunction.Min(vMin)
vResult(9, n) = WorksheetFunction.Max(vMax)
With wsResult 'array Result write on sheet
.Range("b21").CurrentRegion.Offset(2).ClearContents
.Range("b23").Resize(n, 9) = WorksheetFunction.Transpose(vResult)
End With
End Sub