I needed results as in 'Result' column shown in the table below.
I could achieve this with the help of Dan. Here is the script.
X1 | Y1 | X2 | Y2 | X3 | Y3 | X4 | Y4 | X5 | Y5 | Result |
---|---|---|---|---|---|---|---|---|---|---|
Req-BX | BX | Req-EA | EACH | Req-CA | Glove | 1 out of 3 Required | ||||
Req-BT | BOTTLE | Req-GL | Req-CTN | 2 out of 3 Required | ||||||
Req-PR | PAIR | Req-BX | BOX | Req-EA | EACH | Req-CA | CASE | 0 out of 4 Required | ||
DZ | DOZEN | PR | PAIR | PK | 0 out of 0 Required | |||||
Req-PK | PACK | DZ | DOZEN | PR | PAIR | PK | Req-CA | 1 out of 2 Required |
I could achieve this with the help of Dan. Here is the script.
Public Sub Stack()
Dim DataSheet As Worksheet
Dim LastRow As Long, LastCol As Long, _
ResultCol As Long, RowIdx As Long, _
ResultCol2 As Long, _
ColIdx As Long, ReqCounter As Long, _
FoundCounter As Long, _
Str As String
'assign sheet for easy reference
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
'define the range for our loops
LastRow = 1003
LastCol = 100 'column CV
ResultCol = 1 'column CW
ResultCol2 = 2 'column CX
'loop through target rows
For RowIdx = 2 To LastRow
'initialize counters
ReqCounter = 0
FoundCounter = 0
'loop through target columns
For ColIdx = 5 To LastCol Step 2
'check to see if the cell contains "Req" and increment as necessary
If InStr(1, DataSheet.Cells(RowIdx, ColIdx), "REQ", vbTextCompare) > 0 Then
ReqCounter = ReqCounter + 1
If DataSheet.Cells(RowIdx, ColIdx + 1).Value = "" Then
FoundCounter = FoundCounter + 1
'check the neighboring cell for a non-blank value and increment as necessary
If InStr(1, DataSheet.Cells(RowIdx, ColIdx), "REQ", vbTextCompare) > 0 And DataSheet.Cells(RowIdx, ColIdx + 1).Value = "" Then
Str = Str & ", " & DataSheet.Cells(RowIdx, ColIdx).Value
End If
End If
End If
Next ColIdx
'write to the result cell
DataSheet.Cells(RowIdx, ResultCol) = FoundCounter & " out of " & ReqCounter & " Required"
DataSheet.Cells(RowIdx, ResultCol2) = Application.WorksheetFunction.Substitute(Str, "REQUIRED-", "")
Str = ""
Next RowIdx
MsgBox ("Completed")
End Sub
Dim DataSheet As Worksheet
Dim LastRow As Long, LastCol As Long, _
ResultCol As Long, RowIdx As Long, _
ResultCol2 As Long, _
ColIdx As Long, ReqCounter As Long, _
FoundCounter As Long, _
Str As String
'assign sheet for easy reference
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
'define the range for our loops
LastRow = 1003
LastCol = 100 'column CV
ResultCol = 1 'column CW
ResultCol2 = 2 'column CX
'loop through target rows
For RowIdx = 2 To LastRow
'initialize counters
ReqCounter = 0
FoundCounter = 0
'loop through target columns
For ColIdx = 5 To LastCol Step 2
'check to see if the cell contains "Req" and increment as necessary
If InStr(1, DataSheet.Cells(RowIdx, ColIdx), "REQ", vbTextCompare) > 0 Then
ReqCounter = ReqCounter + 1
If DataSheet.Cells(RowIdx, ColIdx + 1).Value = "" Then
FoundCounter = FoundCounter + 1
'check the neighboring cell for a non-blank value and increment as necessary
If InStr(1, DataSheet.Cells(RowIdx, ColIdx), "REQ", vbTextCompare) > 0 And DataSheet.Cells(RowIdx, ColIdx + 1).Value = "" Then
Str = Str & ", " & DataSheet.Cells(RowIdx, ColIdx).Value
End If
End If
End If
Next ColIdx
'write to the result cell
DataSheet.Cells(RowIdx, ResultCol) = FoundCounter & " out of " & ReqCounter & " Required"
DataSheet.Cells(RowIdx, ResultCol2) = Application.WorksheetFunction.Substitute(Str, "REQUIRED-", "")
Str = ""
Next RowIdx
MsgBox ("Completed")
End Sub
No comments:
Post a Comment