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

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

WarPigl3t

Well-known Member
Joined
May 25, 2014
Messages
1,609
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,604
Messages
5,838,326
Members
430,538
Latest member
PedroOliveira

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
Top