Excel VBA: Grouping rows (code doesn't get right results)

[mburch2000]

I currently have VBA code in Excel to pull desired results, but it's not working correctly. I really need help! I am attaching the spreadsheet and the code. In the spreadsheet, I use cells F5:P16 to show the results of my Sub CaptureGrp, so I can see if different sections of code work. Before I run Sub CaptureGrp I delete data from F5:P16.

I have data in cells A5:E16. I am trying to group data based on "A" (RuleID). I created a variable "Scen" based on results of "E" (AcctNum). I am trying to populate "F" (DID1) and "G" (DID2) based on "D" (Side).

Step 1 of populating "F" (DID1) and "G" (DID2):
* If Side = L, then value of "Scen" goes into "G"
* If Side = R, then value of "Scen" goes into "F"
So each row will have a blank in either "F" or "G"

Step 2 of populating "F" (DID1) and "G" (DID2):
* If rows with the same RuleID has a Side of L and R, then the value of "Scen" gets copied to all cells in "G" and all cells in "F"
So after this step, only RuleID's that have only one Side (L or R) will have blank cells in either "F" or "G"

Option Explicit
Private Scen As String
 
Sub CaptureGrp()
'This Function determines the start & end of a RuleID Group
'On the 1st pass the value of "Scen" is placed in DID1 or DID2
'The 2nd pass Groups by RuleID field and determines if blanks need to be filled in for DID1 or DID2
'DID1 works, but the same code used in DID2 did not work
'The section that does DID2 is commented out so you can test rest of Sub
Dim CurrRuleID As String, PrevRuleID As String, NextRuleID As String
Dim DID1 As String, DID2 As String, lBlankCell As String, rBlankCell As String
Dim SameGroup As Boolean, NewGroup As Boolean, hasL As Boolean, hasR As Boolean
Dim rowStart As Integer, rowEnd As Integer, lRow As Integer, Rows As Integer
 
lRow = 5   'Data starts on line 5
rowStart = 0
rowEnd = 0
Rows = 0
hasL = False
hasR = False
Scen = ""
 
For lRow = lRow To 16
    CurrRuleID = Cells(lRow, "A").Value
    PrevRuleID = Cells(lRow - 1, "A").Value
    NextRuleID = Cells(lRow + 1, "A").Value
 
    Call Scenario(lRow, Scen)
    Worksheets("Grouping").Cells(lRow, 15) = Scen
 
    If CurrRuleID = PrevRuleID Then
        SameGroup = True
        Worksheets("Grouping").Cells(lRow, 11).Value = SameGroup
 
        Call hasLorR(lRow, hasL, hasR)  'WORKS
 
        If CurrRuleID <> NextRuleID And rowStart <> 0 Then
            rowEnd = lRow
 
            Call hasLorR(lRow, hasL, hasR)  'WORKS
 
        ElseIf CurrRuleID = NextRuleID And rowStart = 0 Then
            rowStart = lRow
        End If
 
    ElseIf CurrRuleID <> PrevRuleID Then
        NewGroup = True
        Worksheets("Grouping").Cells(lRow, 12).Value = NewGroup
 
        If rowEnd = 0 Then
            rowStart = lRow
        End If
 
        'Inserted code below to fix Single rows where rowStart = rowEnd
        If CurrRuleID <> NextRuleID Then
            If rowEnd = 0 Then
                rowEnd = lRow
            End If
        End If
 
        Call hasLorR(lRow, hasL, hasR)  'WORKS
    End If
    'Used to write results to spreadsheet to verify code section
    Worksheets("Grouping").Cells(lRow, 9).Value = rowStart
    Worksheets("Grouping").Cells(lRow, 10).Value = rowEnd
    Worksheets("Grouping").Cells(lRow, 13).Value = hasL
    Worksheets("Grouping").Cells(lRow, 14).Value = hasR
 
    '1st Pass - Populates Scen for every row   WORKS
    If Worksheets("Grouping").Cells(lRow, 4) = "L" Then
        Worksheets("Grouping").Cells(lRow, 7) = Scen
    Else: Worksheets("Grouping").Cells(lRow, 4) = "R"
        Worksheets("Grouping").Cells(lRow, 6) = Scen
    End If
 
    '2nd Pass - Groups by RuleID field and determines
    'if blanks need to be filled in for DID1 or DID2
    If rowStart < rowEnd And (hasR And hasL = True) Then
        Rows = rowEnd - rowStart
        Worksheets("Grouping").Cells(lRow, 16) = Rows
 
        DID1 = Cells(lRow, "F").Value
        DID2 = Cells(lRow, "G").Value
     'If RuleID has an L and R Side, then results for DID1 and DID2
     'needs to be copied to blank cells with same RuleID group
        For Rows = 1 To Rows
            If DID1 <> "" Then   'Left Side (DID1) WORKS
                Worksheets("Grouping").Cells(lRow - Rows, 6).Value = DID1
            ElseIf DID1 = "" Then
                Cells(lRow, "F").Find("*", SearchOrder:=xlByColumns, SearchDirection:=1) = lBlankCell
                Worksheets("Grouping").Cells(lRow - Rows, 6).Value = lBlankCell
            End If
        Next Rows
        'Code STOPS on section below - commented out to test other sections
        'For Rows = 1 To Rows
        '    If DID2 <> "" Then     'Right Side (DID2)doesn't Work
        '        Worksheets("Grouping").Cells(lRow - Rows, 7).Value = DID2
        '    ElseIf DID2 = "" Then
        '        Cells(lRow, "G").Find("*", SearchOrder:=xlByColumns, SearchDirection:=1) = rBlankCell
        '        Worksheets("Grouping").Cells(lRow - Rows, 7).Value = rBlankCell
        '    End If
        'Next Rows
    End If
 
'If rowStart & rowEnd have been assigned, then reset them
    If rowStart <> 0 And rowEnd <> 0 Then
        rowStart = 0
        rowEnd = 0
        Rows = 0
        hasL = False
        hasR = False
        Scen = ""
    End If
Next lRow
 
End Sub
Function hasLorR(lRow, hasL, hasR)
'Sets hasL and hasR variables based on each row
'hasL and hasR variables are declared in CaptureGrp function
'Variables read at End of Group to determine if rows in Group need a 2nd Pass above
 
    If Worksheets("Grouping").Cells(lRow, 4) = "L" Then
        hasL = True
    Else: Worksheets("Grouping").Cells(lRow, 4) = "R"
        hasR = True
    End If
'hasR and hasL = False were REMOVED to consolidate results to last row of group
 
End Function
Function Scenario(lRow, Scen)
'Determines Scen variable based on AcctNum field
'The end results are placed in either DID1 or DID2 field
 
Dim AcctType As String
Dim Z As String
 
Z = Worksheets("Grouping").Cells(lRow, 5).Value
AcctType = Left(Z, 2)
 
Select Case AcctType
    Case "QM": Scen = "QTOACT"
    Case "CC": Scen = "QTOACT"
    Case "BS": Scen = "FINACT"
    Case "IS": Scen = "FINACT"
End Select
 
End Function
 

I'm not sure if my Excel file attached. Sample Data for cells A5:E16 is below:
RuleID Descr Op Side AcctNum DID1 DID2
AB287 this L < 0 L CC560100
AB287 is L > 0 R CC562050
AB287 not L > 0 R CC562050
CN356 really L Not 0 L QM558040
CN356 important L Not 0 L QM558040
CN356 just R > 0 R BS119060
CN356 a R > 0 R BS119060
DC879 description R Not 0 L QM558040
MX289 anything R > 0 R QM558040
JJ546 field L Not 0 L QM560070
JJ546 name R < 0 R IS170500
EH561 really R < 0 L QM558040

I really appreciate any help I get. Thank you

Mike