# [Solved]Find Subarray Such That the Corresponding Subarray Has Max Sum Value

#### Boy282828

##### New member
Dear Lutfor,

About the last VBA Code you provide to find the SubArray Range in Column N

such that the Corresponding SubArray Range Sum is Maximum in Column O,

I found out that for the same values in Column N, it will ignore the Negative

Values in Column N to get the Max Value SubArray in Column O. For example,

enclosed the 2023NBADEMY.xlsm File, Title “RDF(H-V)” in Column N, Title

“MDOG 4W” in Column O, running the VBA Code it shows that in RDF(H-V)

From 1.700 to 7.300 it will get the Max Sum +4777.48, but it ignores the same

6 elements of 1.700 above it which all gives -100 values in Column O, it also

ignores 1 element of the same 7.300 below it which gives -100 in Column O.

So the Max Sum should be +4777.48 – 7*100 = +4077.48 which is not the

true Max Sum because I just guess a range in Column N from -8.20 to +7.30,

the corresponding Max Sum in Column O is +4554.48 larger than +4077.48.

I am sure my guess is wrong, it is just guessing, there should be a range that

gives the true Max Sum greater than my guess Sum of +4554.48. Could you

modify the VBA Code which include ALL range elements to give the real true

Max Sum? To clear and simplify things, could you in the result statement just

mention in Column N or in Column O, don’t mention the Title names since I

may use different Title names in the future. Thanks,

Boy282828 4/26/2024

I try to upload the excel file named 2023NBADEMYEXCEL.xlsm, it only has one worksheet named "MLDOG RAW" with only 2 real number arrays in Column N and Column O, but it refuse to accept because "The File is too Big", I got confused. I hope you can my point without attaching Excel File.
Thanks,

Boy282828 4/26/2024

I try to upload the excel file named 2023NBADEMYEXCEL.xlsm, it only has one worksheet named "MLDOG RAW" with only 2 real number arrays in Column N and Column O, but it refuse to accept because "The File is too Big", I got confused. I hope you can my point without attaching Excel File.
Thanks,

Boy282828 4/26/2024
Dear

Thanks for sharing your findings regarding the previously provided VBA sub-procedure. You mentioned that for the same values in Column N, it will ignore the Negative Values in Column N to get the Max Value SubArray in Column O. You want to modify the VBA Code, which includes ALL range elements, to give the true Max Sum. Besides, you want to generalize the report message by displaying columns N and O instead of their titles.

I have tried to modify the existing VBA code (previously given) as per your requirements, but I encountered difficulties when testing. It would be great if you could share the data in columns N and O so that I can test it. To do so, you can try sharing the CSV file instead of the Excel file. You can also share the file via a Google Drive or OneDrive link, from which I can download the file.

However, I have worked on displaying the reports you mentioned.

Excel VBA Sub-procedure:
Code:
``````Sub AdvancedFindMaxSubArraySum()

Dim ws As Worksheet
Dim lastRow As Long
Dim maxSum As Double
Dim maxRangeStart As Double
Dim maxRangeEnd As Double
Dim maxRangeElements As Long
Dim maxRange As Range

Set ws = ThisWorkbook.Sheets("SUMMARY")

lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row

maxSum = 0
maxRangeStart = 0
maxRangeEnd = 0
maxRangeElements = 0

For i = 2 To lastRow

rangeStart = ws.Cells(i, "N").Value

For j = i To lastRow

rangeEnd = ws.Cells(j, "N").Value

currentSum = WorksheetFunction.Sum(ws.Range(ws.Cells(i, "O"), ws.Cells(j, "O")))

If currentSum > maxSum Then
maxSum = currentSum
maxRangeStart = rangeStart
maxRangeEnd = rangeEnd
maxRangeElements = j - i + 1

Set maxRange = ws.Range(ws.Cells(i, "N"), ws.Cells(j, "N"))
End If
Next j
Next i

MsgBox "The SubArray in column N ranges from " & Format(maxRangeStart, "0.000") & " to " & Format(maxRangeEnd, "0.000") & " such that the Max Sum Value is " & Format(maxSum, "0.00") & " with " & maxRangeElements & " elements SubArray in column O."

If Not maxRange Is Nothing Then
maxRange.Select
End If

End Sub``````

So, try to share the file with me. Hopefully, you want to display the Results and Reports within the MsgBox, as shown in the image above.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy

Dear Lutfor,

Per your instructions I saved the Excel File named “2023NBADEMYEXCEL” as .csv File,

But Microsoft said if I save in .csv File, some features may be lost. I hope you can see it and

edit the VBA Code. Thanks,

Boy282828 4/30/2024

Dear Lutfor,

Per your instructions I saved the Excel File named “2023NBADEMYEXCEL” as .csv File,

But Microsoft said if I save in .csv File, some features may be lost. I hope you can see it and

edit the VBA Code. Thanks,

Boy282828 4/30/2024
Dear, Please share the Excel file through OneDrive, as I cannot open it.

Regards
Lutfor Rahman Shimanto
ExcelDemy

Dear Lutfor,

About the last VBA Code you provide to find the SubArray Range in Column N

such that the Corresponding SubArray Range Sum is Maximum in Column O,

I found out that for the same values in Column N, it will ignore the Negative

Values in Column N to get the Max Value SubArray in Column O. For example,

enclosed the 2023NBADEMY.xlsm File, Title “RDF(H-V)” in Column N, Title

“MDOG 4W” in Column O, running the VBA Code it shows that in RDF(H-V)

From 1.700 to 7.300 it will get the Max Sum +4777.48, but it ignores the same

6 elements of 1.700 above it which all gives -100 values in Column O, it also

ignores 1 element of the same 7.300 below it which gives -100 in Column O.

So the Max Sum should be +4777.48 – 7*100 = +4077.48 which is not the

true Max Sum because I just guess a range in Column N from -8.20 to +7.30,

the corresponding Max Sum in Column O is +4554.48 larger than +4077.48.

I am sure my guess is wrong, it is just guessing, there should be a range that

gives the true Max Sum greater than my guess Sum of +4554.48. Could you

modify the VBA Code which include ALL range elements to give the real true

Max Sum? To clear and simplify things, could you in the result statement just

mention in Column N or in Column O, don’t mention the Title names since I

may use different Title names in the future. Thanks,

Boy282828 4/26/2024
Dear Dawson Chuang

Thanks for your patience! I was able to get the data from your shared link. I have reviewed your requirements and found that you were right. So, I improved the existing algorithm and developed a new sub-procedure to fulfil your goal.

SOLUTION Overview:

Excel VBA Sub-procedure:
Code:
``````Sub SumValuesBasedOnUniqueItems()

Dim ws As Worksheet
Dim lastRow As Long
Dim cell As Range
Dim uniqueValues As New Collection
Dim dict As Object
Dim item As Variant
Dim key As Variant

Set ws = ThisWorkbook.Sheets("in")

lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row

For Each cell In ws.Range("N2:N" & lastRow)
If Not IsEmpty(cell.Value) Then
On Error Resume Next
On Error GoTo 0
End If
Next cell

Set dict = CreateObject("Scripting.Dictionary")

For Each item In uniqueValues
Dim sumValue As Double
sumValue = 0

For Each cell In ws.Range("N2:N" & lastRow)
If cell.Value = item Then
sumValue = sumValue + cell.Offset(0, 1).Value ' Sum corresponding value in column O
End If
Next cell

If Not dict.Exists(item) Then
End If

Next item

Dim wsNew As Worksheet

wsNew.Name = "Temporary"

Z = 2

For Each key In dict.keys
Sheets("Temporary").Range("N" & Z).Value = key
Sheets("Temporary").Range("O" & Z).Value = dict(key)
Z = Z + 1
Next key

Dim wsNext As Worksheet
Dim lstRow As Long
Dim maxSum As Double
Dim maxRangeStart As Double
Dim maxRangeEnd As Double
Dim maxRangeElements As Long
Dim maxRange As Range

Set wsNext = ThisWorkbook.Sheets("Temporary")

lstRow = wsNext.Cells(wsNext.Rows.Count, "N").End(xlUp).Row

maxSum = 0
maxRangeStart = 0
maxRangeEnd = 0
maxRangeElements = 0

For i = 2 To lstRow

rangeStart = wsNext.Cells(i, "N").Value

For j = i To lstRow

rangeEnd = wsNext.Cells(j, "N").Value

currentSum = WorksheetFunction.Sum(wsNext.Range(wsNext.Cells(i, "O"), wsNext.Cells(j, "O")))

If currentSum > maxSum Then
maxSum = currentSum
maxRangeStart = rangeStart
maxRangeEnd = rangeEnd

Set maxRange = wsNext.Range(wsNext.Cells(i, "N"), wsNext.Cells(j, "N"))
End If
Next j
Next i

Dim topValue As Double
Dim bottomValue As Double
Dim bottomCell As Range
Dim topCell As Range
Dim cellT, cellB As Range

topValue = maxRange.Cells(1, 1).Value
bottomValue = maxRange.Cells(maxRange.Rows.Count, maxRange.Columns.Count).Value

For Each cellT In ws.Range("N2:N" & lastRow)
If cellT.Value = topValue Then
Set topCell = cellT
Exit For
End If
Next cellT

For Each cellB In ws.Range("N2:N" & lastRow)
If cellB.Value = bottomValue Then
Set bottomCell = cellB
Exit For
End If
Next cellB

Do While bottomCell.Value = bottomCell.Offset(1, 0).Value

Set bottomCell = bottomCell.Offset(1, 0)

Loop

maxRangeElements = bottomCell.Row - topCell.Row + 1

ws.Activate
ws.Range("N" & topCell.Row & ":N" & bottomCell.Row).Select

Sheets("Temporary").Delete

MsgBox "The SubArray in column N ranges from " & Format(maxRangeStart, "0.000") & " to " & Format(maxRangeEnd, "0.000") & " such that the Max Sum Value is " & Format(maxSum, "0.00") & " with " & maxRangeElements & " elements SubArray in column O.", vbInformation

End Sub``````

The previous algorithm worked perfectly on the data for unique values. But your current dataset has multiple non-contiguous cells that contain the same value in column N. So, the enhanced algorithm first finds the unique values and also calculates the sum for each. Later, it adds a temporary sheet and stores those values (which will be deleted at the end of all tasks). Finally, with the help of the previous algorithm, I was able to find the true Max-Sum.

I hope you have found an ultimate solution to Find a Subarray such that the Corresponding Subarray Has a Max-Sum Value. I have attached the solution workbook for better understanding; good luck.

Regards
Lutfor Rahman Shimanto
Excel & VBA Developer
ExcelDemy

#### Attachments

40.1 KB · Views: 1
Dear Lutfor,
Great! It works perfect! Thanks,
Boy282828 5/5/2024
Dear Dawson Chuang, you are most welcome. We are glad that the solution worked perfectly.

Regards
ExcelDemy

Last edited by a moderator:

Members online
0
Guests online
66
Total visitors
66