I am trying to sum values based on like-conditions, such as Date, the project, and the Bucket. Below is the test data that I am working with:
| Date | Project | Bucket | Hours |
|---|---|---|---|
| 2022-03-28 | ALN-1150 | Time Bucket | 1 |
| 2022-03-28 | ALN-1150 | Time Bucket | 1 |
| 2022-03-28 | ALN-1150 | Time Bucket | 2.5 |
| 2022-03-29 | ALN-1150 | Time Bucket | 3 |
| 2022-03-29 | ALN-1150 | Time Bucket | 2 |
| 2022-03-30 | ALN-1500 | Time Bucket | 1 |
| 2022-03-30 | ALN-1500 | OMSH225 | 1 |
I tried to use the following to check how many like-items there were, but that only worked for the first date and stopped after that...
Sub addTime()
Dim CountRows As Integer
Dim Counter As Integer
CountRow = 1
Counter = 1
Do While Len(Sheets("Formatting").Range("A1").Offset(rowOffset:=CountRow)) > 0
Do While Sheets("Formatting").Range("A1").Offset(rowOffset:=Counter).Value = Sheets("Formatting").Range("A1").Offset(rowOffset:=(Counter 1)).Value _
And Sheets("Formatting").Range("B1").Offset(rowOffset:=Counter).Value = Sheets("Formatting").Range("B1").Offset(rowOffset:=(Counter 1)).Value _
And Sheets("Formatting").Range("C1").Offset(rowOffset:=Counter).Value = Sheets("Formatting").Range("C1").Offset(rowOffset:=(Counter 1)).Value _
Counter = Counter 1
Loop
CountRow = CountRow 1
Loop
Debug.Print "Number of like Values: " CStr(Counter)
End Sub
What I am expecting is:
| Date | Project | Bucket | Hours | Total |
|---|---|---|---|---|
| 2022-03-28 | ALN-1150 | Time Bucket | 1 | 4.5 |
| 2022-03-28 | ALN-1150 | Time Bucket | 1 | |
| 2022-03-28 | ALN-1150 | Time Bucket | 2.5 | |
| 2022-03-29 | ALN-1150 | Time Bucket | 3 | 5 |
| 2022-03-29 | ALN-1150 | Time Bucket | 2 | |
| 2022-03-30 | ALN-1500 | Time Bucket | 1 | 1 |
| 2022-03-30 | ALN-1500 | OMSH225 | 1 | 1 |
Any help is greatly appreciated, as I have been stuck on this all day. Thank you
CodePudding user response：
It was not clear to me, if you wanted count or totals, so I have provided code which does both. It will be easy for you to amend to remove the values you don't want.
Dim LastRow As Integer
Dim i As Integer
Dim Count As Integer
Dim FirstRowInGroup As Long
Dim RunningTotal As Double
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
FirstRowInGroup = 2
Count = 1
For i = 2 To LastRow - 1
If i = FirstRowInGroup Then
RunningTotal = Cells(i, 4)
End If
If Cells(i, 1) = Cells(i 1, 1) And _
Cells(i, 2) = Cells(i 1, 2) And _
Cells(i, 3) = Cells(i 1, 3) Then
Count = Count 1
RunningTotal = RunningTotal Cells(i 1, 4)
Else
Cells(FirstRowInGroup, 5) = Count
Cells(FirstRowInGroup, 6) = RunningTotal
Count = 1
FirstRowInGroup = i 1
End If
Next
'Deal with last row being different
If Cells(LastRow, 1) <> Cells(LastRow - 1, 1) Or _
Cells(LastRow, 2) <> Cells(LastRow - 1, 2) Or _
Cells(LastRow, 3) <> Cells(LastRow - 1, 3) Then
Cells(LastRow, 5) = 1
Cells(LastRow, 6) = Cells(LastRow, 4)
End If
Please note that this solution depends on alike items being consecutive (grouped together), as in your sample data. If this is not the case, then you will need to sort the data (based on the three "like" columns) first. If for whatever reason that is impractical, then I can provide you with an alternative solution.
CodePudding user response：
If VBA is needed for whatever reason you could use the ADODB library to achieve that. The result will be independent of the order of the rows. Alike rows don't need to be grouped together. On the other hand the code will print for each single row the result on the right hand side which you might not want.
Option Explicit
Sub mySumIfS()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sSQL As String
Dim xlFile As String
xlFile = ThisWorkbook.FullName
' connect to this workbook
With cn
.Provider = "Microsoft.ACE.OLEDB.16.0"
.ConnectionString = "Data Source=" & xlFile & "; Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
' the result of this SQL staetement is the sum of hours grouped by Date and Bucket
sSQL = "SELECT Date, Bucket, Sum(Hours) AS Total FROM [Sheet1$] GROUP BY Date, Bucket;"
Set rs = cn.Execute(sSQL)
Dim rg As Range, sngRow As Range, wks As Worksheet
Set wks = ActiveSheet
Set rg = wks.Range("A1").CurrentRegion
Set rg = rg.Offset(1).Resize(rg.Rows.CountLarge - 1)
' Loop through the input data
' filter the result by Date and bucket
' print the total of hours to the right
For Each sngRow In rg.Rows
rs.Filter = "[Date] = " & sngRow.Cells(1, 1).Value & " AND [Bucket] = '" & sngRow.Cells(1, 3).Value & "'"
sngRow.Cells(1, 1).Offset(, 4).Value = rs.Fields(2).Value
Next
End Sub
If you do want to count instead of the total you only need to change the SQL statement slightly
sSQL = "SELECT Date, Bucket, Count(Hours) AS Total FROM [Sheet1$] GROUP BY Date, Bucket;"
CodePudding user response：
Perhaps try something like the below:
Sub addTime()
Dim SumHours As Double
Dim sh As Worksheet
Dim rng As Range
Dim row As Range
Dim arr(3) As Variant
Set sh = ThisWorkbook.Sheets("Formatting")
Set rng = sh.Range("A2:E8") 'expand as necessary or write function to obtain the total range to be checked
SumHours = 0
equal = False
arr(0) = 2
For Each row In rng.Rows
equal = (arr(1) = row.Cells(1, 1) And arr(2) = row.Cells(1, 2) And arr(3) = row.Cells(1, 3))
If (Not equal) Then
sh.Cells(arr(0), 5) = SumHours
arr(0) = row.row
arr(1) = row.Cells(1, 1)
arr(2) = row.Cells(1, 2)
arr(3) = row.Cells(1, 3)
SumHours = row.Cells(1, 4)
ElseIf equal Then
SumHours = SumHours row.Cells(1, 4)
End If
Next
End Sub
It loops through all the rows in your range and stores the row of the first value, then keeps summing the values as long as all three cell values are equal?
You may need to write a function that returns a Range so that you can appropriately determine the valid range.
This yields the below result:
