VBA coding for creating summary report needed

noelcab1

New Member
Joined
Sep 14, 2014
Messages
1
In sheet1 column A are the dates and on column D are the names of people.
I would like to generate a summary report on Sheet 2 using VBA code. I know that this can be done with Pivot table. however I need vba codes for it.
I was able to get a summary of occurences of the dates. however i need the breakdown of it per person per day.

Sample of sheet 1 and it goes on to a long list, the names are constant variables
DateItemPriceName
8/18/2014Bam
8/18/2014Joe
8/18/2014Jane
8/18/2014Drew
8/18/2014John
8/18/2014Darwin
8/18/2014Angel
8/18/2014Eric
8/18/2014Ken
8/18/2014Vin
8/18/2014Don
8/18/2014Sam

<tbody>
</tbody>

I need on sheet 2 to produce
DatetotalBamjoejanedrewjohndarwinangelerickenvindonsamaprilstacey
8/18/201475
8/19/201489
8/20/201486
8/21/201494
8/22/2014108
8/25/2014176
8/26/2014176
8/27/2014174
8/28/2014206
8/29/2014193
9/2/2014209
9/3/201496
9/4/2014261
9/5/2014195
9/12/20141
9/16/20144

<tbody>
</tbody>


Thanks in advance.
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Code:
sht1 = "Sheet 1"
sht2 = "Sheet 2"
'This code will populate unique dates from sht1 to sht2.
lastRowSht1 = Sheets(sht1).Range("A" & Rows.Count)End(xlup).Row
i = 2
Do Until i > lastRowSht1
     output = TRUE
     lastRowSht2 = Sheets(sht2).Range("A" & Rows.Count).End(xlup).Row
     ii = 2
     Do Until ii > lastRowSht2
          If Sheets(sht1).Range("A" & i).value = Sheets(sht2).Range("A" & ii).value Then
               output = FALSE
          End If
          ii = ii + 1
     Loop
     If output = TRUE Then
          Sheets(sht2).Range("A" & ii).value = Sheets(sht1).Range("A" & i).value
     End If
     i = i + 1
Loop

'This code will populate unique names from sht1 to sht2
i = 2
Do Until i > lastRowSht1
     output = TRUE
     ii = 3
     Do Until Sheets(sht2).Range(Column(ii) & "1").value = ""
          If Sheets(sht1).Range("C" & i).value = Sheets(sht2).Range(Column(ii) & "1").value Then
               output = FALSE
          End If
     Loop
     If output = TRUE Then
          Sheets(sht2).Range(Column(ii) & "1").value = Sheets(sht1).Range("C" & i).value
     End If
     i = i + 1
Loop 

'This code counts totals per person per day
lastRowSht2 = Sheets(sht2).Range("A" & Rows.Count).End(xlup).Row
i = 2
Do Until i > lastRowSht2
     ii = 3
     Do Until Sheets(sht2).Range(Column(ii) & "1").value = ""
          iii = 2
          Do Until iii > lastRowSht1
               If Sheets(sht1).Range("A" & iii).value = Sheets(sht2).Range("A" & i).value And _
                    Sheets(sht1).Range("D" & iii).value = Sheets(sht2).Range(Column(ii) & "1").value Then
                    Sheets(sht2).Range(Column(ii) & i).value = Sheets(sht2).Range(Column(ii) & i).value + 1
               End If
               iii = iii + 1
          Loop
          ii = ii + 1
     Loop
     i = i + 1
Loop

'This code totals per day of all persons.
i = 2
Do Until i > lastRowSht2
     ii = 2
     Do Until ii > lastRowSht1
          If Sheets(sht2).Range("A" & i).value = Sheets(sht1).Range("A" & ii).value Then
               Sheets(sht2).Range("A" & i).value = Sheets(sht2).Range("A" & i).value + 1
          End If 
          ii = ii + 1
     Loop
     i = i + 1
Loop
I did this all in my head so there may be syntax errors you might have to fix, but the logic is sound.
 
Upvote 0

Forum statistics

Threads
1,211,869
Messages
6,104,474
Members
447,910
Latest member
abrook1308

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top