(VBA) Highlight rows of range of number that sums to a specific value

[youngernest]

I have 27 columns with 1000+ rows starting from row 7 with headers. Column G, starting G7, contains amount with decimals. Let's say I put a specific value in cell $G$3, when I run the vba, it will highlight the entire rows that sum to the the specific value of cell $G$3 in yellow. I know there might be a possibility of a few combinations, but I just need one combination. I know this can be done using solver. However, I need something that can be done with only one click of a button.

For example

Specific Value = -2.93

1.90

-5.62

3.4

-4.83

Entire rows of 1.90 and -4.83 will be highlight in yellow.

I tried below code but it seems not to be working the way I intended.

Sub HighlightRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim sumValue As Double
    Dim currentSum As Double
    Dim rng As Range
    Dim cell As Range
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Get the last row in column G
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    
    ' Get the sum value from cell G3
    sumValue = ws.Range("G3").Value
    
    ' Set the range to highlight
    Set rng = ws.Range("G7:G" & lastRow)
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Reset the current sum
        currentSum = 0
        
        ' Check if the cell and the previous cells in the row sum up to the specified value
        For Each c In Range(cell.Offset(0, -6), cell.Offset(0, -1))
            currentSum = currentSum + c.Value
        Next c
        
        ' Check if the current sum matches the specified value
        If currentSum = sumValue Then
            ' Highlight the entire row in yellow
            ws.Range("A" & cell.Row & ":AA" & cell.Row).Interior.Color = RGB(255, 255, 0)
        End If
    Next cell
End Sub

 

[Marius44]

Hi
Try with the corrections

Sub HighlightRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim sumValue As Double
    Dim currentSum As Double
    Dim rng As Range
    Dim cell As Range
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets(1)
    ws.Cells.Interior.Color = xlNone  'no color in the sheet
    ' Get the last row in column G
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    ' Get the sum value from cell G3
    sumValue = ws.Range("G3").Value
    ' Set the range to highlight
    Set rng = ws.Range("G7:G" & lastRow)
    ' Loop through each cell in the range
    For Each cell In rng
        
        cc = cell.Value   'current amount
        ' Reset the current sum
        currentSum = 0
        
        ' Check if the cell and the previous cells in the row sum up to the specified value
        For Each c In Range(cell(1, 1), cell(lastRow - 6, 1))
            currentSum = cc + c.Value
        'Next c
        ' Check if the current sum matches the specified value
        If currentSum = sumValue Then
            Stop ' Highlight the entire row in yellow
            ws.Range("A" & cell.Row & ":AA" & cell.Row).Interior.Color = RGB(255, 255, 0)
            ws.Range("A" & c.Row & ":AA" & c.Row).Interior.Color = RGB(255, 255, 0)
        
        End If
        Next c
    Next cell

End Sub

Hi,
Mario