DA Form 6

[SavageMind]

Hi all this is my first post.

I am creating a DA Form 6 wich is used to determine duty cycles. The first two colums A&B are for rank and name by row. the next 40 colums are to put numbers and symbols to determine who's turn it is. the first person will have a / then will count down from the number of names on the worksheet. so if there are 30 names, the first person will have / in colum C and will couunt down from 29 until it reaches 1 then it will have another / until it reaches the end of the 40 colums. The second name will have a 1 in colum C, a / in colum D and then it will count down. I would like to automate this document so it will autofill these cells, will allow exceptions and caculate for exceptions. The proper filing out of this document is covered in AR 220-45 and has an example wich can be googled. My Excel knowledge is limited any help would be great thanks.

SavageMind

 

[dakota727]

I don't have the HTML addin on my excel here so I can't post the spreadsheet. Anyway here is what I have. With your duty roster template. Make sure cell D7 is the first cell of day 1 of the roster for the first man on your list. Row 6 is your list of dates starting at D6 and column D from 7 on is manually completed by you. Now paste the following code into a module.

Public Sub CreateRoster()
'Use manual entries in the first day of the roster to calculate the rest.

Dim intRowTotal As Integer, intColTotal As Integer, row As Integer, col As Integer
Dim MaxDay As Integer, ManualNum As Integer
Dim MyRange As Range

intpress = MsgBox("Is the first day of the Duty Roster (Column D) complete?", vbYesNo)
'Makes sure that day 1 is complete
If intpress = 7 Then
Exit Sub
Else
intRowTotal = ActiveSheet.Range("B7", ActiveSheet.Range("b65536").End(xlUp)).Count
intColTotal = ActiveSheet.Range("D6", ActiveSheet.Range("bZ6").End(xlToLeft)).Count
'Calculate number of people and number of days for the roster
For k = 1 To intColTotal - 1
'k tracks the number of days
col = 4 + k
'start on 2nd day
    For N = 1 To intRowTotal
    'N tracks each person
    If ActiveSheet.Cells(6 + N, col).Value = "" Then
        'Do this when the cell value is empty
        If ActiveSheet.Cells(6 + N, col - 1).Value = "D" Then
        ActiveSheet.Cells(6 + N, col).Value = 1
        'If had the duty day prior set to 1
        Else
            If Application.WorksheetFunction.IsNumber(ActiveSheet.Cells(6 + N, col - 1).Value) = True Then
            ActiveSheet.Cells(6 + N, col).Value = ActiveSheet.Cells(6 + N, col - 1).Value + 1
            'if prior day was a number add 1
            Else
                i = 1
                Do Until Application.WorksheetFunction.IsNumber(ActiveSheet.Cells(6 + N, col - i).Value) = True
                i = i + 1
                If col - i = 0 Then Exit Do
                'if prior day not a number then look back to next day prior
                Loop
                If col - i = 0 Then
                'if we reach o then prompt for the number of the person
                ManualNum = InputBox("Enter " & ActiveSheet.Cells(6 + N, 1).Value & " " & ActiveSheet.Cells(6 + N, 2).Value & " previous Roster Number?")
                ActiveSheet.Cells(6 + N, col).Value = ManualNum + 1
                Else
                'If number found add 1 to it
                ActiveSheet.Cells(6 + N, col).Value = ActiveSheet.Cells(6 + N, col - i).Value + 1
                End If
            End If
        End If
    Else
    GoTo skip
    'if the cell is filled skip it dont overright it
    End If
    Next N
    'once the entire column is filled in
    Set MyRange = ActiveSheet.Range(Cells(7, col), Cells(7 + intRowTotal, col))
    MaxDay = Application.WorksheetFunction.Max(MyRange)
    'find the largest number
    MaxDay = Application.WorksheetFunction.Match(MaxDay, MyRange, 0)
    ActiveSheet.Cells(6 + MaxDay, col).Value = "D"
    'replace largest number with "D"
skip:
 Next k
 'Do next day
End If
End Sub

Now go through the roster and put in any leave or absences. Save the spreadsheet and then run the macro CreateRoster... One thing if the first day of the roster has a guy on leave what number should he be when he comes off leave. It will prompt you for their previous number. Since this thread is getting quite long you may want to just send me a private message to work out the final details.

Let me know how close it is.

 

[StephenGKorea]

Book1
	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG
6	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30
7	1	2	3	4	5	6	7	8	9	10	11	12	D	P	P	P	P	D	1	2	3	4	5	6	D	1	2	3	4	5
8	2	3	4	5	6	7	D	1	2	3	4	5	6					7	D	1	2	3	4	5	6	D	1	2	3	4
9	3	4	5	6	7	D	1	L	L	L	L	L	2					3	4	5	6	7	8	D	1	2	3	4	5	6
10	4	5	6	7	D	1	2						3					4	5	6	7	8	D	1	2	3	4	5	6	D
11	5	6	7	D	1	2	3						4					5	6	7	8	D	1	2	3	4	5	6	D	1
12	6	7	D	1	2	3	4						5					6	7	8	D	1	2	3	4	5	6	D	1	2
13	7	D	1	2	3	4	5						6					7	8	D	1	2	3	4	5	6	D	1	2	3
Sheet1

 

[StephenGKorea]

It has a few bugs as you can see above, but I can try to work it a bit and post the code here.

When I first attempted this project a few years back, I had no idea about VBA or this forum. I am glad this was asked here, because I love reworking old failed projects

I think we should keep it here since there is more the 2 interested parties involved in this, and would be interesting to use this forum as a collaborative site.

 

[dakota727]

I have it completed, I think? If you would like to test it out Private Message me your email and I'll send you a file. Here is kind of what it looks like.

Duty Roster.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
3	DUTYROSTER		NATUREOFDUTY
4			KitchenPolice
5	GRADE	NAME	Month	December
6			Day	1	2	3	4	5	6	7	8	9	10	11
7	SGT	Smith		D	1	2	3	4	5	6	7	8	9	10
8	SGT	Jones		11	D	1	2	3	4	5	6	7	8	9
9	SGT	Johnson		10	11	D	1	2	3	4	5	6	7	8
10	SGT	Merrick		9	10	11	D	1	2	3	4	5	6	7
11	SGT	Schroeder		8	9	10	11	D	1	2	3	4	5	6
12	SGT	Noel		L	L	L	L	L	L	L	L	3	4	5
13	SGT	Sledge		7	8	9	10	11	D	1	2	3	4	5
14	SGT	Brown		L	6	7	8	9	10	11	D	1	2	3
15	SGT	White		6	7	8	9	10	11	D	1	2	3	4
16	SGT	Black		5	6	7	8	9	10	11	12	D	1	2
17	SPC	Houston		S	6	S	7	S	8	9	10	11	S	12
18	SPC	Jersey		4	5	6	7	8	9	10	11	12	D	1
19	SPC	Jackson		E	E	E	6	7	8	9	10	11	12	D
Sheet1

 

[dakota727]

Here is the corrected code I used to generate the roster above:

Public Sub CreateRoster()

'Use manual entries in the first day of the roster to calculate the rest.

Dim intRowTotal As Integer, intColTotal As Integer, row As Integer, col As Integer
Dim MaxDay As Integer, ManualNum As Integer
Dim MyRange As Range

intpress = MsgBox("Is the first day of the Duty Roster (Column D) complete?", vbYesNo)
'Makes sure that day 1 is complete
If intpress = 7 Then
Exit Sub
Else
intRowTotal = ActiveSheet.Range("B7", ActiveSheet.Range("b65536").End(xlUp)).Count
intColTotal = ActiveSheet.Range("D6", ActiveSheet.Range("bZ6").End(xlToLeft)).Count
'Calculate number of people and number of days for the roster
For k = 1 To intColTotal - 1
'k tracks the number of days
col = 4 + k
'start on 2nd day
    For n = 1 To intRowTotal
    'N tracks each person
    If ActiveSheet.Cells(6 + n, col).Value = "" Then
        'Do this when the cell value is empty
        If ActiveSheet.Cells(6 + n, col - 1).Value = "D" Then
        ActiveSheet.Cells(6 + n, col).Value = 1
        'If had the duty day prior set to 1
        Else
            If Application.WorksheetFunction.IsNumber(ActiveSheet.Cells(6 + n, col - 1).Value) = True Then
            ActiveSheet.Cells(6 + n, col).Value = ActiveSheet.Cells(6 + n, col - 1).Value + 1
            'if prior day was a number add 1
            Else
            If ActiveSheet.Cells(6 + n, col - 1).Value = "D" Then
            ActiveSheet.Cells(6 + n, col).Value = 1
            End If
            i = 1
                Do Until Application.WorksheetFunction.IsNumber(ActiveSheet.Cells(6 + n, col - i).Value) = True Or ActiveSheet.Cells(6 + n, col - i).Value = "D"
                i = i + 1
                If col - i = 0 Then Exit Do
                'if prior day not a number then look back to next day prior
                Loop
                If col - i = 0 Then
                'if we reach o then prompt for the number of the person
                ManualNum = InputBox("Enter " & ActiveSheet.Cells(6 + n, 1).Value & " " & ActiveSheet.Cells(6 + n, 2).Value & " previous Roster Number?")
                ActiveSheet.Cells(6 + n, col).Value = ManualNum + 1
                Else
                'If number found add 1 to it
                    If ActiveSheet.Cells(6 + n, col - i).Value = "D" Then
                    ActiveSheet.Cells(6 + n, col).Value = 1
                    Else
                    ActiveSheet.Cells(6 + n, col).Value = ActiveSheet.Cells(6 + n, col - i).Value + 1
                    End If
                End If
            End If
        End If
    Else
   
   
    End If
    Next n
    'once the entire column is filled in
    Set MyRange = ActiveSheet.Range(Cells(7, col), Cells(7 + intRowTotal, col))
    MaxDay = Application.WorksheetFunction.Max(MyRange)
    'find the largest number
    MaxDay = Application.WorksheetFunction.Match(MaxDay, MyRange, 0)
    ActiveSheet.Cells(6 + MaxDay, col).Value = "D"
    'replace largest number with "D"

 Next k
 'Do next day
End If
ActiveSheet.Range(Cells(5, 5), Cells(5, 43)).Value = ""
EndMonth = Application.WorksheetFunction.Choose(Month(Cells(4, 37)), "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
n = 43
Do Until ActiveSheet.Cells(6, n).Value = 1
n = n - 1
Loop
ActiveSheet.Cells(5, n).Value = EndMonth
End Sub

 

[SavageMind]

Look Great I would Like to try it. I now have to figure out how to caculate weekend and holidays as a seperate sequence

 

[dakota727]

I have my sheet skipping weekends and any dates typed into my holiday list. Like in my example below the 23 is skipped because of turkey day and the 25 and 26 were skipped (weekend)

Holiday Duty Roster.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
5	GRADE	NAME	Month	November
6			Day	20	21	22	23	24	25	26	27	28	29	30	1
7	SGT	Smith		1	2	3		4			5	6	7	8	9
8	SGT	Jones		2	3	4		5	S	S	S	S	S	6	7
9	SGT	Johnson		3	4	5		6			7	8	9	10	11
10	SGT	Merrick		L	L	L		5			6	7	8	9	10
11	SGT	Schroeder		5	6	7		8			9	10	11	12	13
12	SGT	Noel		D	1	2		3			4	5	6	7	8
13	SGT	Sledge		7	8	9		10			11	12	13	14	15
14	SGT	Brown		8	9	10		11			12	13	14	15	16
Sheet1

 

[1SG]

Is there anyway you could shoot me a copy of this. I could really use the help. surfcowby@hotmail.com I hate duty rosters, so any help that I can get would be much appreciated. Thanks

 

[dakota727]

I posted some copies of various DA Form 6 at

http://myexcelfiles.webs.com/military.htm

You can download what I was working on and hopefully modify to meet you needs.

 

[joshthejoker]

I know it has been awhile since you've posted your files dakota727, but would you happen to still have them? I was also trying to create something similar to this and am stuck on getting the weekday and weekend/holiday dates to be two separate number sequences. I was hoping that by looking at your work I could figure out where I was going wrong.