chriscorpion786
Board Regular
- Joined
- Apr 3, 2011
- Messages
- 108
- Office Version
- 365
- Platform
- Windows
Hi All,
I have data like below and I need to summarize this data, I have done it by name, but I also need it by name and category.
I have posted the code below and have done it the way I understand it. The code works perfectly, I need help to summarize by name going down the rows and category by columns. Please keep the code simple for me to understand.
Thanks in advance.
<colgroup><col><col><col><col><col span="9"></colgroup><tbody>
</tbody>
Sub UsingDates2()
Dim sht As Worksheet
Dim lastrow As Long
Dim names() As String
Dim namecount As Long
Dim rptsht As Worksheet
Dim x As Long
Dim i As Long
Dim currentname As String
Dim totals() As Long
Dim startdate As Integer
Dim enddate As Integer
Dim rng As Range
Set sht = Sheets("Sales")
'rpthsht is the output sheet
Set rptsht = Sheets("By Date")
startdate = sht.Cells.Find(what:=rptsht.Range("A2"), LookIn:=xlValues).Column ' there is an input cell for the start date
enddate = sht.Cells.Find(what:=rptsht.Range("B2"), LookIn:=xlValues).Column ' there is an input cell for the end date
lastrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
rptsht.Range("D:E").Columns.Clear
sht.Range("A1:A" & lastrow).AdvancedFilter _
xlFilterCopy, copytorange:=rptsht.Range("D2"), Unique:=True
With rptsht.Range("D2")
namecount = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
ReDim names(namecount)
ReDim totals(namecount)
For x = 1 To namecount
names(x) = .Offset(x, 0).value
Next x
End With
With sht.Range("A1")
For x = 1 To Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
currentname = .Offset(x, 0).value
For i = 1 To namecount
If currentname = names(i) Then
Set rng = sht.Cells(x + 1, startdate).Resize(1, (enddate - startdate + 1))
totals(i) = totals(i) + .Offset(x, 2).value * _
Application.WorksheetFunction.Sum(sht.Range(rng.Address))
End If
Next i
Next x
End With
With rptsht.Range("D2")
.Offset(0, 1).value = "Totals"
For i = 1 To namecount
.Offset(i, 1).value = totals(i)
Next i
Range(.Offset(0, 0), .Offset(0, 1).End(xlDown)).Select
End With
Call FormatNumbers
Call Borders
End Sub
I have data like below and I need to summarize this data, I have done it by name, but I also need it by name and category.
I have posted the code below and have done it the way I understand it. The code works perfectly, I need help to summarize by name going down the rows and category by columns. Please keep the code simple for me to understand.
Thanks in advance.
Name | Products | Price | 1/1/2018 | 1/2/2018 | 1/3/2018 | 1/4/2018 | 1/5/2018 | 1/6/2018 | 1/7/2018 | 1/8/2018 | 1/9/2018 | 1/10/2018 |
Rose | Signal | $9 | $3,840 | $21,423 | $43,866 | $41,216 | $22,205 | $27,415 | $16,106 | $13,661 | $30,739 | $21,301 |
Martin | Signal | $5 | $1,683 | $14,130 | $22,007 | $4,171 | $4,875 | $7,482 | $7,556 | $38,711 | $23,799 | $16,584 |
Larry | Crest | $10 | $1,385 | $29,714 | $26,646 | $29,605 | $32,303 | $19,401 | $12,516 | $10,065 | $16,425 | $38,025 |
Cynthia | Signal | $3 | $2,126 | $24,838 | $4,508 | $31,995 | $10,708 | $34,345 | $14,862 | $34,503 | $37,713 | $29,050 |
Dunya | Flare | $9 | $2,370 | $17,714 | $15,744 | $2,367 | $43,627 | $41,822 | $36,244 | $6,514 | $41,071 | $38,226 |
Edgar | Flare | $10 | $3,973 | $27,881 | $39,808 | $24,010 | $23,306 | $32,518 | $4,852 | $33,482 | $28,120 | $32,301 |
Rihab | Fluroide | $9 | $830 | $6,740 | $41,281 | $10,329 | $14,280 | $19,681 | $13,917 | $13,405 | $8,196 | $22,091 |
Nicholas | Fluroide | $9 | $1,970 | $14,595 | $20,319 | $1,134 | $5,950 | $38,813 | $39,644 | $3,271 | $30,752 | $20,275 |
Itab | Crest | $10 | $4,720 | $20,497 | $35,001 | $42,054 | $28,596 | $5,265 | $3,256 | $15,880 | $34,592 | $34,039 |
Bassam | Fluroide | $3 | $2,660 | $23,119 | $5,500 | $29,915 | $23,576 | $39,683 | $16,610 | $17,937 | $40,609 | $29,920 |
Ghawth | Signal | $6 | $2,532 | $2,910 | $13,391 | $23,389 | $2,742 | $41,157 | $27,545 | $8,243 | $2,965 | $23,088 |
Judy | Flare | $7 | $3,650 | $4,302 | $21,379 | $42,989 | $44,058 | $2,169 | $16,835 | $6,672 | $22,397 | $13,874 |
June | Flare | $7 | $3,216 | $25,260 | $38,488 | $12,435 | $6,235 | $25,875 | $29,741 | $32,106 | $3,718 | $37,861 |
Yahya | Flare | $9 | $1,429 | $17,217 | $38,507 | $20,036 | $30,885 | $26,426 | $23,691 | $27,909 | $13,554 | $39,062 |
Najiyah | Fluroide | $7 | $641 | $25,468 | $1,382 | $41,895 | $33,026 | $27,617 | $28,380 | $5,173 | $42,534 | $25,058 |
Nahid | Fluroide | $9 | $2,592 | $16,044 | $44,058 | $39,204 | $2,222 | $37,545 | $34,881 | $41,851 | $33,634 | $26,368 |
Itab | Flare | $10 | $3,778 | $3,287 | $13,134 | $24,028 | $41,153 | $42,918 | $24,741 | $30,223 | $10,567 | $37,699 |
Nashah | Flare | $5 | $1,312 | $13,139 | $1,178 | $24,346 | $21,672 | $19,321 | $6,651 | $3,569 | $16,775 | $14,472 |
<colgroup><col><col><col><col><col span="9"></colgroup><tbody>
</tbody>
Sub UsingDates2()
Dim sht As Worksheet
Dim lastrow As Long
Dim names() As String
Dim namecount As Long
Dim rptsht As Worksheet
Dim x As Long
Dim i As Long
Dim currentname As String
Dim totals() As Long
Dim startdate As Integer
Dim enddate As Integer
Dim rng As Range
Set sht = Sheets("Sales")
'rpthsht is the output sheet
Set rptsht = Sheets("By Date")
startdate = sht.Cells.Find(what:=rptsht.Range("A2"), LookIn:=xlValues).Column ' there is an input cell for the start date
enddate = sht.Cells.Find(what:=rptsht.Range("B2"), LookIn:=xlValues).Column ' there is an input cell for the end date
lastrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
rptsht.Range("D:E").Columns.Clear
sht.Range("A1:A" & lastrow).AdvancedFilter _
xlFilterCopy, copytorange:=rptsht.Range("D2"), Unique:=True
With rptsht.Range("D2")
namecount = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
ReDim names(namecount)
ReDim totals(namecount)
For x = 1 To namecount
names(x) = .Offset(x, 0).value
Next x
End With
With sht.Range("A1")
For x = 1 To Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).Rows.Count
currentname = .Offset(x, 0).value
For i = 1 To namecount
If currentname = names(i) Then
Set rng = sht.Cells(x + 1, startdate).Resize(1, (enddate - startdate + 1))
totals(i) = totals(i) + .Offset(x, 2).value * _
Application.WorksheetFunction.Sum(sht.Range(rng.Address))
End If
Next i
Next x
End With
With rptsht.Range("D2")
.Offset(0, 1).value = "Totals"
For i = 1 To namecount
.Offset(i, 1).value = totals(i)
Next i
Range(.Offset(0, 0), .Offset(0, 1).End(xlDown)).Select
End With
Call FormatNumbers
Call Borders
End Sub