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.
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

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.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,550
Messages
5,529,472
Members
409,884
Latest member
Msinmath
Top