VBA to Add 2 Rows and Text and Formula

L

luke6843

New Member
Joined
Jul 14, 2017
Messages
3
Iam not very good with VBA but I do take existing code and adapt it the best Ican to do what I need. I am now at aloss for this problem trying all I can to get it to work. I am using this code:<o:p></o:p>
<o:p> </o:p>
Rich (BB code): 
<o:p></o:p>
Rich (BB code):
Rich (BB code): 
Subinsertem()<o:p></o:p>
Dimr As Long<o:p></o:p>
Forr = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1<o:p></o:p>
    If Range("L" & r).Value<> Range("L" & r - 1) Then<o:p></o:p>
        Rows(r).Insert<o:p></o:p>
    End If<o:p></o:p>
Nextr<o:p></o:p>
EndSub<o:p></o:p>
<o:p></o:p>
<o:p> </o:p>
toadd extra rows in between dates – see Exhibit 1. What I need it to do now is add 2 rowsinstead of 1. Then put the word “Total”in column A of the first 2 rows. Thenput a SUM formula in columns G, H and I totaling only up to the last blank row –see Exhibit 2.<o:p></o:p>
<o:p> </o:p>
Exhibit1<o:p></o:p>
<o:p>
Excel Workbook
ABCDEFGHIJKL
1Item NumberDescriptionCustomer CodeCustomer NameSO NumberQty Sched (Cases)Widgets Total #Screws Total #OtherLABELS RANDefectiveDue Date
2607170Widget 1Customer 18495210020000Tuesday, July 25, 2017
3623641Widget 2Customer 285359350139900Tuesday, July 25, 2017
4300010Widget 3Customer 385361102000Tuesday, July 25, 2017
5300013Widget 4Customer 385361102000Tuesday, July 25, 2017
6605345Widget 5Customer 3853615010000Tuesday, July 25, 2017
7606241Widget 6Customer 38536120060000Tuesday, July 25, 2017
8610014Widget 7Customer 38536110020000Tuesday, July 25, 2017
9607140Widget 8Customer 4854087014000Tuesday, July 25, 2017
10607210Widget 9Customer 585408204000Tuesday, July 25, 2017
11
12150650Widget 10Cutomer 6841731000200000Wednesday, July 26, 2017
13600000Widget 11Customer 78509818937800Wednesday, July 26, 2017
14600006Widget 12Customer 7850986312600Wednesday, July 26, 2017
151250Widget 13Customer 88516731207488Wednesday, July 26, 2017
16622414Widget 14Customer 9852399649920Wednesday, July 26, 2017
17
18600500Widget 15Customer 108516415030000Thursday, July 27, 2017
19600501Widget 16Customer 108516415030000Thursday, July 27, 2017
20602366Widget 17Customer 11854938717400Thursday, July 27, 2017
21624565Widget 18Customer 108550210016000Thursday, July 27, 2017
22
23606142Widget 19Customer 12852815611200Monday, July 31, 2017
24606143Widget 20Customer 128528122467200Monday, July 31, 2017
25606149Widget 21Customer 12852815616800Monday, July 31, 2017
26
27600000Widget 11Customer 78509918937800Wednesday, August 02, 2017
28
29606143Widget 20Customer 128526511233600Thursday, August 03, 2017
30
31600000Widget 11Customer 78510018937800Wednesday, August 09, 2017
32600006Widget 12Customer 7851006312600Wednesday, August 09, 2017
33
34606142Widget 19Customer 128526661200Thursday, August 10, 2017
35606143Widget 20Customer 128526610631800Thursday, August 10, 2017
36
Sheet1
</o:p>
<o:p></o:p>
<o:p> </o:p>
Exhibit2
Excel Workbook
ABCDEFGHIJKL
1Item NumberDescriptionCustomer CodeCustomer NameSO NumberQty Sched (Cases)Widgets Total #Screws Total #OtherLABELS RANDefectiveDue Date
2607170Widget 1Customer 18495210020000Tuesday, July 25, 2017
3623641Widget 2Customer 285359350139900Tuesday, July 25, 2017
4300010Widget 3Customer 385361102000Tuesday, July 25, 2017
5300013Widget 4Customer 385361102000Tuesday, July 25, 2017
6605345Widget 5Customer 3853615010000Tuesday, July 25, 2017
7606241Widget 6Customer 38536120060000Tuesday, July 25, 2017
8610014Widget 7Customer 38536110020000Tuesday, July 25, 2017
9607140Widget 8Customer 4854087014000Tuesday, July 25, 2017
10607210Widget 9Customer 585408204000Tuesday, July 25, 2017
11Total91010400016790
12
13150650Widget 10Cutomer 6841731000200000Wednesday, July 26, 2017
14600000Widget 11Customer 78509818937800Wednesday, July 26, 2017
15600006Widget 12Customer 7850986312600Wednesday, July 26, 2017
161250Widget 13Customer 88516731207488Wednesday, July 26, 2017
17622414Widget 14Customer 9852399649920Wednesday, July 26, 2017
18Total16605040024992
19
20600500Widget 15Customer 108516415030000Thursday, July 27, 2017
21600501Widget 16Customer 108516415030000Thursday, July 27, 2017
22602366Widget 17Customer 11854938717400Thursday, July 27, 2017
23624565Widget 18Customer 108550210016000Thursday, July 27, 2017
24Total487174007600
25
26606142Widget 19Customer 12852815611200Monday, July 31, 2017
27606143Widget 20Customer 128528122467200Monday, July 31, 2017
28606149Widget 21Customer 12852815616800Monday, July 31, 2017
29Total336952000
30
31600000Widget 11Customer 78509918937800Wednesday, August 02, 2017
32Total189378000
33
Sheet2


Any help or suggestions would be greatly appreciated.
Thanks
Luke
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Hello,

does this work as expected?

Code: 
Sub insertem1()
Dim r As Long
For r = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
If Range("L" & r).Value <> Range("L" & r - 1) Then
Rows(r).Insert
Rows(r).Insert
End If
Next r
For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row + 1
    If IsEmpty(Range("a" & r).Value) Then
        Range("A" & r).Value = "Total"
        MY_END = Range("A" & r - 1).Row
        MY_START = Range("A" & r - 1).End(xlUp).Row
        If MY_START = 1 Then MY_START = 2
        Range("F" & r).Formula = "=sum(F" & MY_START & ":F" & MY_END & ")"
        Range("F" & r).Copy Range("G" & r & ":I" & r)
        r = r + 1
    End If
Next r
End Sub
 
Upvote 0
Wow, works perfectly. I understand how you added the second row and how you got it to add only the necessary rows. This is great! Thanks!

Luke
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
XLOOKUP with multiple criteria across multiple columns and rows
Replies
6
Views
1K
soriaul
S
O
  • Solved
VBA - Filter columns, cut/paste rows new sheet, pivot table
2
Replies
12
Views
315
Skyybot
Skyybot
togenmoser
  • Solved
Finding all possible combinations of 2 sums
2
Replies
10
Views
724
togenmoser
togenmoser
A
  • Solved
hide row if 2 cell of same row is blank
Replies
3
Views
154
Joe4
Joe4
G
  • Locked
  • Question Question
Optimized version shows error
Replies
1
Views
518
Fluff
Fluff

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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