Excel VBA about total up all values in a range and write it at a desired cell

[huiyin9218]

Hi,

May i know how to write a code to sum up the numbers of each date in second column and write it at the side of each serial number (For example : location A and B)?
As you can see, serial number 1 has 2 dates and serial number 2 only have one date, how do i write a code to sum all the numbers between the serial numbers as the dates sometimes can go up to 5 dates per serial number?

Serial Number 1		A
8 july 2018	1
4 july 2018	1
Serial Number 2		B
8 july 2018	1

<tbody>
</tbody>

I would be so grateful for your help.

 

[Tim_Excel_]

Hi,

Do I understand correctly you want the cell after the date to show many times this specific date occurs within the serial number? It would be of great help if you were to give us a depiction of the results you wish to get.

 

[huiyin9218]

Hi,

Sorry for not stating it clearly.
I wish to sum up the number of "1" in each serial number, the sum will be written at two cells next to the serial number (the answer that i wish to get is shown with red color in the table)

Serial Number 1		2
8 july 2018	1
4 july 2018	1
Serial Number 2		1
8 July 2018	1
Serial Number 3		3
7 July 2018	1
2 July 2018	1
1 July 2018	1

<tbody>
</tbody>

 

[Tim_Excel_]

This is a VERY quick and dirty solution and could surely be done better, but it works.
I've pasted this in my Worksheet module, if used in another module make sure to get the references right:

Sub datecounter()
For Each cell In Range("B:B")
If cell = "" And cell.Offset(1, 0) = "" Then Exit For
If IsEmpty(cell.Value) Or cell.Value = "" Or cell.Row = Cells(Rows.Count, "B").End(xlUp).Row Then cell.Offset(0, 1).Value = "x"
Next cell
For Each cell In Range("C:C")
If cell.Row = Cells(Rows.Count, "B").End(xlUp).Row Then
cell.Value = ""
Exit For
End If
If cell.Value = "x" Then
Debug.Print cell.Address(0, 0)
nextx = Range("C:C").Find("x", Range(cell.Address(0, 0))).Offset(0, -1).Address(0, 0)
cell.Value = WorksheetFunction.Sum(Range(cell.Offset(0, -1).Address(0, 0) & ":" & nextx))
End If
Next cell
End Sub

 

[huiyin9218]

Thank you so much!!