VBA coding for creating summary report needed

[noelcab1]

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

Date	Item	Price	Name
8/18/2014			Bam
8/18/2014			Joe
8/18/2014			Jane
8/18/2014			Drew
8/18/2014			John
8/18/2014			Darwin
8/18/2014			Angel
8/18/2014			Eric
8/18/2014			Ken
8/18/2014			Vin
8/18/2014			Don
8/18/2014			Sam

<tbody>
</tbody>

I need on sheet 2 to produce

Date

total

Bam

joe

jane

drew

john

darwin

angel

eric

ken

vin

don

sam

april

stacey

8/18/2014

75

8/19/2014

89

8/20/2014

86

8/21/2014

94

8/22/2014

108

8/25/2014

176

8/26/2014

176

8/27/2014

174

8/28/2014

206

8/29/2014

193

9/2/2014

209

9/3/2014

96

9/4/2014

261

9/5/2014

195

9/12/2014

1

9/16/2014

4

<tbody>
</tbody>

Thanks in advance.

 

[WarPigl3t]

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.