VBA loop to split up data based on count and week

E

Earlyfreak

New Member
Joined
Jan 31, 2017
Messages
16
I am looking for a direction to automate this manual intense process. I have different counts to do each week example
Week 5
53
Week 6
30
Week 7
51
Week 8
55
Week 9
51
Week 10
60
I am looking to take the week total and split it into 5 workdays to complete
The problem is each week is different. I manually split and process now.
I can do this with formula's that I know of
Is there a VBA solution?
Any direction would be greatly appriciated

Here is example data
Item DescriptionWeek #Completion Date
711N 50 GAL 40 BTU NAT GASWeek 5May 19th
710N 40 GAL 40 BTU NAT GASWeek 5May 19th
709N 40 GAL 40 BTU NAT GASWeek 5May 19th
706-1NCWW 50 GAL 240VWeek 5May 19th
712N 48 GAL 40 BTU NAT GASWeek 5May 19th
691N 75 GAL 76 BTU NAT GASWeek 5May 19th
774S6N 50 GAL 40 BTU NAT GASWeek 5May 19th
702-1NCWW 40 GAL 240VWeek 5May 19th
705-1NCWW 40 GAL 240VWeek 5May 19th
557-1NCZZ 208V / 4500Week 5May 19th
4711NAL RESIDENTIAL ELECTRICWeek 5May 19th
728T6N 50 GAL 40 BTU NAT GASWeek 5May 19th
2150N 50 GAL 40 BTU NAT 10YRWeek 5May 19th
747H6N 75 GAL 76 BTU NAT GASWeek 5May 19th
703-1NCWW 50 GAL 240VWeek 5May 19th
704-1NCWW 30 GAL 240VWeek 5May 19th
690N 48 GAL 65 BTU NAT GASWeek 5May 19th
16900 BW 240V-4500W STD ELMTWeek 5May 19th
469-1NAL RESIDENTIALWeek 5May 19th
2190N 40 GAL 40 BTU NAT 10YRWeek 5May 19th
465-1NAL 10 GAL ELECT HEATERWeek 5May 19th
759-1NCWW 38 GAL 240VWeek 5May 19th
758-1NCWW 28 GAL 240VWeek 5May 19th
8920N 75 GAL 76 BTU NAT GASWeek 5May 19th
726T6N 40GAL 40 BTU NAT GASWeek 5May 19th
6955H6N 75 GAL 80 BTU NATWeek 5May 19th
713S6N 40 GAL 40 BTU NAT GASWeek 5May 19th
7320H6N 48 GAL 60 BTU NATWeek 5May 19th
767X 40 GAL 38 BTU LP GASWeek 5May 19th
760-1NCWW 47 GAL 240VWeek 5May 19th
470-1NAL RESIDENTIAL ELECTRWeek 5May 19th
812LVL 1 UPGRD HTR KITWeek 5May 19th
707N 30 GAL 32 BTU NAT GASWeek 5May 19th
765X 50 GAL 36 BTU LP GASWeek 5May 19th
29801 BW KIT-NAT GAS VALVEWeek 5May 19th
779T6X 50 GAL 40 BTU LP GASWeek 5May 19th
681R-L 40 GAL INDIRECTWeek 5May 19th
764X 40 GAL 36 BTU LP GASWeek 5May 19th
895N 40 GAL 34 BTU NAT GASWeek 5May 19th
701N 50 GAL 50 BTU NAT GASWeek 5May 19th
777S6X 50 GAL 38 BTU LP GASWeek 5May 19th
29200 BW VAPOR SENSORWeek 5May 19th
782H6X 75 GAL 75.5 BTU LPWeek 5May 19th
73400 BW VENT TERMINAL /Week 5May 19th
7460S6N 50 GAL 40 BTU NATWeek 5May 19th
496763N 75 GAL 76 BTU NATWeek 5May 19th
730H6N 48 GAL 65 BTU NAT GASWeek 5May 19th
31305 BW PILOT-NAT 17/26 HONWeek 5May 19th
2200N 48 GAL 40 BTU NAT 10YRWeek 5May 19th
69300 UPPER&LOWER T STATWeek 5May 19th
221T 10GAL 240V/4KW 208V/3KWWeek 5May 19th
680R-L 50 GAL INDIRECTWeek 5May 19th
7340S6N 40 GAL 40 BTU NATWeek 5May 19th
864V PILOT *** Y 190 NAT RKWeek 6May 26th
958TI-540H NG TANKLESS HTRWeek 6May 26th
6926005 KIT PILOT WITHWeek 6May 26th
6964005 KIT GAS CONTROLWeek 6May 26th
53TUBING 560-742-860Week 6May 26th
541631 NEUTRALIZER KITWeek 6May 26th
89C THERM ROLLOUT SWITCHWeek 6May 26th
544620 MAINTENANCE KIT F/Week 6May 26th
379ON ELECTRODE KIT F/ULTRAWeek 6May 26th
14SWITCH 24V 510-300-013Week 6May 26th
90 ASSY W/CABLE 511-330-218Week 6May 26th
131TRIM EG-PIDN 381-800-837Week 6May 26th
836N CGA-4-PIDN GAS BLR 2012Week 6May 26th
837N CGA-5-PIDN GAS BLR 2012Week 6May 26th
893N EG30-50 GAS CTRL 2012Week 6May 26th
542630 ULTRA P/T GAUGEWeek 6May 26th
32ECKETT BURNERWeek 6May 26th
27ERMOSTAT RES 633-900-130Week 6May 26th
898N EG40-45 JACKET 2012Week 6May 26th
58HOOD EG-45 450-021-258Week 6May 26th
55HOOD EG-40 450-021-257Week 6May 26th
24R KIT 511-330-148Week 6May 26th
9460-020 THERMOSTAT RPR KITWeek 6May 26th
39N ASSY EG 40-45Week 6May 26th
56N RELAY 24V 510-350-223Week 6May 26th
888N EG45 BASE ASSY 2012Week 6May 26th
1720-658 U-CONTROL F/ULTRAWeek 6May 26th
65RELAY W/RECP. 510-312-166Week 6May 26th
33ECKETT BURNERWeek 6May 26th
835N CGA-3PIDN GAS BLR 2012Week 6May 26th

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
I am not sure I have understood your issue correctly but the below code will split each week data by inserting a row between them. If you could show us a sample of the output that you need perhaps we can assist you more.

Assuming your data starts in A1

Code: 
Sub Insert_Row()

Dim lRow As Double
lRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For x = lRow To 3 Step -1
    If Cells(x, 3).Value <> Cells(x, 3).Offset(-1, 0).Value Then
        Rows(x).EntireRow.Insert
    End If
Next x

End Sub
 
Upvote 0
Thanks mse330

The loop is a start I wanted to loop through every 5 items, then assign the first day Monday to those 5 items then
The next 5 to Tues etc then on the next week start over. Do not know if VBA can do this.

I ended up running a pivot the copy values and formatting not ideal but quicker then formula's

I looking to split like this

Completion DateWeek #DayItem Description
19-MayWeek 5Monday311298239-47463-01 BW KIT-NAT GAS VALVE
640701BW RG250S6N 50 GAL 50 BTU NAT GAS
640703BW RE350S6-1NCWW 50 GAL 240V
640712BW RG250L6N 48 GAL 40 BTU NAT GAS
640726BW RG2PV40T6N 40GAL 40 BTU NAT GAS
640746BW RG2PDV50S6N 50 GAL 40 BTU NAT
640760BW RE250L6-1NCWW 47 GAL 240V
654693265-51046-00 UPPER&LOWER T STAT
687219BW RG240T10N 40 GAL 40 BTU NAT 10YR
739557BW RE250L6-1NCZZ 208V / 4500
Tuesday640691BW RG275H6N 75 GAL 76 BTU NAT GAS
640704BW RE330S6-1NCWW 30 GAL 240V
640711BW RG250T6N 50 GAL 40 BTU NAT GAS
640777BW RG1PV50S6X 50 GAL 38 BTU LP GAS
640779BW RG2PV50T6X 50 GAL 40 BTU LP GAS
642465BW RE110U6-1NAL 10 GAL ELECT HEATER
642470BW RE1-2U6-1NAL RESIDENTIAL ELECTR
642471BW RE16U6-1NAL RESIDENTIAL ELECTRIC
642695BW RG2PDV75H6N 75 GAL 80 BTU NAT
643496B/W LG275H763N 75 GAL 76 BTU NAT
684221LE110U31NCT 10GAL 240V/4KW 208V/3KW
Wednesday297812BW SINGLE LVL 1 UPGRD HTR KIT
311292239-45560-00 BW VAPOR SENSOR
640680BW SW-2-50R-L 50 GAL INDIRECT
640681BW SW-2-40R-L 40 GAL INDIRECT
640690BW RG250H6N 48 GAL 65 BTU NAT GAS



<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
You are welcome ... I put the below code which will basically insert the day next to the first item starting from Monday then will skip 5 items & goes to the 6th item & insert Tuesday ... etc.. skipping the weekends of Friday & Saturday. Again assuming your data start in cell A1

Try the below code & let me know if this is what you are looking for

Code: 
Sub Split()

Dim lRow As Long, dDate As Date
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
dDate = #1/1/2018#
Cells(1, 5).Value = "Day"

For x = 2 To lRow Step 5
    Cells(x, 5).Value = Format(dDate, "DDDD")
    dDate = WorksheetFunction.WorkDay_Intl(dDate, 1)
Next x

End Sub
 
Upvote 0
If you wish to have the day filled in each row, you can use the below code

Code: 
Sub Split_Fill()

Dim lRow As Long, dDate As Date
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
dDate = #1/1/2018#

For x = 1 To lRow - 1
    Cells(x, 5).Value = Format(dDate, "DDDD")
    If x Mod 5 = 0 Then dDate = WorksheetFunction.WorkDay_Intl(dDate, 1)
Next x

Cells(1, 5).Insert Shift:=xlDown
Cells(1, 5).Value = "Day"

End Sub
 
Upvote 0
Thanks again mse330

That works, pretty slick. Tried both and even added
Code: 
Rows(x).EntireRow.Insert
Between form your early example

final
Code: 
Sub Split()
Dim lRow As Long, dDate As Date
lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
dDate = #1/1/2018#
Cells(1, 5).Value = "Day"
For x = 2 To lRow Step 6
    Cells(x, 5).Value = Format(dDate, "DDDD")
    dDate = WorksheetFunction.WorkDay_Intl(dDate, 1)
    Rows(x).EntireRow.Insert
Next x
End Sub
​
Each week has different amounts of counts which divide into the 5 work day differently. Is there a way to count the week no total and divide the split number equaly among the 5 days?

Thanks for getting me the right direction. Much appreciated
​
 
Upvote 0
Glad I could help ... It is much easier for me if you can you show me example of the desired output :)
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,214,641
Messages
6,120,693
Members
448,979
Latest member
DET4492

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