Insert Titles on Immediate Top Rows of Each Sale Rep

[Warmhearted]

Hello,

I manually insert titles on immediate top rows of each Sale Rep in this "worksheet" as shown below. This title is saved on "heading" sheet.
Then, I highlight days that have same date sale as you can see below. Finally, I print report for each of Sale Reps for their record only.

Can you help create a VBA code that do:
1. Insert titles on immediate top rows of each Sale Rep
2. Highlight days that have same sale date
3. Print reports for each of the Sale Rep for their own record only. ( I used to highlight A1-J4, A5-J14.... and so on, then print selection.)

Thanks for your help!

 

[Michael M]

IS the data sorted by Name and date ??
Why is row 8 highlighted....is that an error ??
Can you have a look at using the XL2BB download to upload a sample of your data ....see my sig !!

 

[Warmhearted]

IS the data sorted by Name and date ??
Why is row 8 highlighted....is that an error ??
Can you have a look at using the XL2BB download to upload a sample of your data ....see my sig !!

Hi Michael,
This sheet is a result of an already VBA I had. I just need another VBA that I will add to my current VBA to complete my learning.
Why is row 8 highlighted....is that an error ??-No, row 8 has one day transaction. It was highlighted due to above its 3 transactions was left blank. It was highlighted as blank-highlighted-blank-highlighted pattern.
Yes, I will download XL2BB to try. Thanks Michael!

 

[Michael M]

Might pay to add the code you are using as well ...

 

[Warmhearted]

Might pay to add the code you are using as well ...

Hi Michael,
I wish I can do what you offer. I am 70 years old, and learning VBA is my hobby. If you can help, I appreciate it, if not you have my thanks also.

 

[Michael M]

Sorry, I meant copy / paste the code you are currently using on here, so we can have a look at it

 

[Warmhearted]

Sorry, I meant copy / paste the code you are currently using on here, so we can have a look at it

Hi Michael,
Here is VBA that you want to see:

I hope this screen shot meet your require. Thanks for your help Michael!

 

[Michael M]

We would need a useable code....we can't copy that into a worksheet as is.
And if you use XL2BB to post a block of data as well so we can work on it.

 

[Warmhearted]

Let me try how to use lx2bb. Thanks Michael!

 

[Warmhearted]

We would need a useable code....we can't copy that into a worksheet as is.
And if you use XL2BB to post a block of data as well so we can work on it.

Branches' Lost and PaidTesting.xlsm
	A
1	Sub LearningVBA()
2	'
3	' LearningVBA Macro
4	'
5
6	'
7	Sheets("CurrentOriginalData").Select
8	Application.ScreenUpdating = False
9	With Range("G1", Range("G" & Rows.Count).End(xlUp))
10	.AutoFilter Field:=1, Criteria1:="credit_card_payment"
11	.Offset(1).EntireRow.Delete
12	.Parent.AutoFilterMode = False
13	End With
14	Application.ScreenUpdating = True
15	Columns("B:B").Select
16	Application.CutCopyMode = False
17	ActiveWorkbook.Worksheets("CurrentOriginalData").Sort.SortFields.Clear
18	ActiveWorkbook.Worksheets("CurrentOriginalData").Sort.SortFields.Add Key:= _
19	Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
20	xlSortNormal
21	With ActiveWorkbook.Worksheets("CurrentOriginalData").Sort
22	.SetRange Range("A1:P350")
23	.Header = xlGuess
24	.MatchCase = False
25	.Orientation = xlTopToBottom
26	.SortMethod = xlPinYin
27	.Apply
28	End With
29	Columns("A:A").Select
30	ActiveWorkbook.Worksheets("CurrentOriginalData").Sort.SortFields.Clear
31	ActiveWorkbook.Worksheets("CurrentOriginalData").Sort.SortFields.Add Key:= _
32	Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
33	xlSortNormal
34	With ActiveWorkbook.Worksheets("CurrentOriginalData").Sort
35	.SetRange Range("A1:P350")
36	.Header = xlGuess
37	.MatchCase = False
38	.Orientation = xlTopToBottom
39	.SortMethod = xlPinYin
40	.Apply
41	End With
42	Sheets("CurrentOriginalData").Select
43	Range("A1:Q350").Select
44	Selection.Copy
45	Sheets("Worksheet").Select
46	Range("A1").Select
47	ActiveSheet.Paste
48	Sheets("Worksheet").Select
49
50	Dim lr As Long, r As Long, fr As Long
51	fr = 1
52	lr = Range("A" & Rows.Count).End(xlUp).Row
53	r = 1
54	Do While r <= lr
55	r = r + 1
56	If Cells(r, 1).Value <> Cells(r - 1, 1).Value Then
57	Rows(r).Resize(3).Insert
58	Cells(r, 3).FormulaR1C1 = "=SUM(R" & fr & "C:R[-1]C)"
59	r = r + 3
60	fr = r
61	lr = lr + 3
62	End If
63	Loop
64	With Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
65	.Formula = "=IF(OR(AND(A2=A3,B2=B3),B2=""""),"""",SUMIFS(C$2:C2,A$2:A2,A2,B$2:B2,B2))"
66	.Value = .Value
67	End With
68	Application.ScreenUpdating = True
69	Sheets("Heading").Select
70	Range("A1:J1").Select
71	Selection.Copy
72	Sheets("Worksheet").Select
73	Range("A1:J1").Select
74	Selection.Insert Shift:=xlDown
75	Range("F3").Select
76	End Sub
77
78
Sheet4