Macro for Auto Inserting a Number Incrementally (+1) in the footer of Excel2010

bobbyd98682 · May 24, 2012

I'm sorry if this has been discussed elsewhere but I have been looking all over for this answer. I feel like this is my last resort; I hope you can help.

I am in charge of developing forms on Excel. With ONE worksheet containing only ONE form, each workbook will have any number of worksheets (from 1 to over 200).

I have created a macro designed to insert the required header and footer information, for each form (AKA each worksheet), simultaneously for the entire workbook.

Now here is my challenge. Within the required footer information, each worksheet (form) must have a unique number (e.g., 7510001); the department is 751 and the first form number will be 0001. The next form (worksheet) must have the number 7510002 in its footer information, and so on.

What I would prefer is the ability to insert the first number (possibly in a pop-up screen) and then have the macro populate the increments for the rest of the worksheets within the workbook.

Is this possible?

Thank you in advance.

Bob

xld · May 24, 2012

[pre]

Code:

Sub AddFooters()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

ws.PageSetup.LeftFooter = &#34;751&#34; & Format(ws.Index, &#34;0000&#34;)
Next ws
End Sub

[/pre]

Hui · May 24, 2012

I would suggest extracting the Department number from the worksheet

So using XLD's code, and assume that the Dep't code is in A1 on each sheet

[pre]

Code:

Sub AddFooters()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

ws.PageSetup.LeftFooter = Format(ws.range(&#34;a1&#34;).value,&#34;000&#34;) & Format(ws.Index, &#34;0000&#34;)
Next ws
End Sub

[/pre]

bobbyd98682 · May 24, 2012

I appreciate both answers above.

Hui, one challenge I face is that there are many different forms of equally differing sizes, so having a dedicated cell is not possible.

xld, I played around with your code, trying to make it fit my situation but am unfamiliar enough to not be able to work out the auto-numbering part.

The closest I got to having what I need was:

[pre]

Code:

.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & &#34;&#34; & Chr(10) & &#34;751&#34; & Format(Index, &#34;0000&#34;)

I probably should have done this at the onset but here is the code I've come to use.

As you can see, it is the "7510001.r01" that is my struggle.


Sub Set_All_Sheets()
Dim wkbktodo As Workbook
Dim ws As Worksheet
Set wkbktodo = ActiveWorkbook
For Each ws In wkbktodo.Worksheets
With ws.PageSetup
.CenterHeader = &#34;&18Facilities Maintenance Instrument 1 Week Checklist&#34;
.LeftFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Route Completed Form to Group Lead for Processing&#34; & Chr(10) & &#34;&#34; & Chr(10) & &#34;Retention: 11yrs&#34;
.CenterFooter = &#34;PROPRIETARY INFORMATION&#34;
.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & &#34;&#34; & Chr(10) & &#34;7510001.r01&#34;
End With
Next ws
End Sub

[/pre]
Thanks again for your help.

Luke M · May 24, 2012

We could use an InputBox. For now, I've defined it as a string, with no error handling if user doesn't input anything.

How's this?

[pre]

Code:

Sub Set_All_Sheets()
Dim wkbktodo As Workbook
Dim ws As Worksheet
Dim DeptCode As String
Set wkbktodo = ActiveWorkbook

&#39;Gather&#39;s user input
DeptCode = InputBox(&#34;What is the dept#?&#34;, &#34;Dept#&#34;)
i = 1
For Each ws In wkbktodo.Worksheets
With ws.PageSetup
.CenterHeader = &#34;&18Facilities Maintenance Instrument 1 Week Checklist&#34;
.LeftFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Route Completed Form to Group Lead for Processing&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & &#34;Retention: 11yrs&#34;
.CenterFooter = &#34;PROPRIETARY INFORMATION&#34;
.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & DeptCode & Format(i, &#34;0000&#34;)
End With
i = i + 1
Next ws
End Sub

[/pre]

bobbyd98682 · May 25, 2012

Thank you all so much for your help.

I was able to get the code I need form another site.

This was exactly what I needed:

[pre]

Code:

Sub Set_All_Sheets()

Const StartNum As Long = 7510001

Dim wkbktodo As Workbook
Dim wsIndex As Long

Set wkbktodo = ActiveWorkbook

For wsIndex = 1 To wkbktodo.Worksheets.Count
With wkbktodo.Sheets(wsIndex).PageSetup
.CenterHeader = &#34;&18Facilities Maintenance Instrument 1 Week Checklist&#34;
.LeftFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Route Completed Form to Group Lead for Processing&#34; & Chr(10) & &#34;&#34; & Chr(10) & &#34;Retention: 11yrs&#34;
.CenterFooter = &#34;PROPRIETARY INFORMATION&#34;
.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & &#34;&#34; & Chr(10) & StartNum + wsIndex - 1 & &#34;.rev01&#34;
End With
Next wsIndex

End Sub

[/pre]
Bob

bobbyd98682 · May 25, 2012

I'm sorry but I do not know how to mark this thread as solved...but it is...solved.

Luke M · May 25, 2012

Glad you found a solution. It does look like the macro you posted requires you to change the code every time you want to use a different dept, but perhaps that is not really an issue. Come back again sometime!

bobbyd98682 · May 29, 2012

Hey there Luke,

You have inspired me to customize my coding to exactly what I want, however, I've run into a little snag.

I don't know enough VBA to set the line of code to fill my header with the results from the input boxes (HeaderCraft and HeaderInterval).

I've played around with different configurations but keep getting the run-time error "unable to set up the CenterHeader property of the PageSetup class.

Could you take a look and help?

Thank you,

Bob

[pre]

Code:

Sub Set_All_Sheets_W_InputBox()
Dim wkbktodo As Workbook
Dim ws As Worksheet
Dim HeaderCraft As String, HeaderInterval As String, DeptCode As String
Set wkbktodo = ActiveWorkbook

&#39;Gather&#39;s user input
HeaderCraft = InputBox(&#34;What is the Craft?&#34;, &#34;Craft&#34;)
HeaderInterval = InputBox(&#34;What is the PM Interval?&#34;, &#34;PM Interval&#34;)
DeptCode = InputBox(&#34;What is the dept#?&#34;, &#34;Dept#&#34;)
i = 1
For Each ws In wkbktodo.Worksheets
With ws.PageSetup
.CenterHeader = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&18Facilities Maintenance&#34; & HeaderCraft & HeaderInterval & &#34;Checklist&#34;
.LeftFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Route Completed Form to Group Lead for Processing&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & &#34;Retention: 11yrs&#34;
.CenterFooter = &#34;PROPRIETARY INFORMATION&#34;
.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & DeptCode & Format(i, &#34;0000&#34;)
End With
i = i + 1
Next ws

End Sub

[/pre]

bobbyd98682 · May 29, 2012

Hi Luke,

I figured this all out on my own, thanks to your code.

Check this out. I am so excited!

[pre]

Code:

Sub Set_All_Sheets()
Dim wkbktodo As Workbook
Dim ws As Worksheet
Dim DeptCode As String
Set wkbktodo = ActiveWorkbook

&#39;Gather&#39;s user input
Craft = InputBox(&#34;What is the Craft?&#34;, &#34;Craft&#34;)
Interval = InputBox(&#34;What is the PM Interval?&#34;, &#34;Interval&#34;)
DeptCode = InputBox(&#34;What is the Department Code?&#34;, &#34;Department&#34;)
i = InputBox(&#34;What is the Starting Number?&#34;, &#34;Number&#34;)
For Each ws In wkbktodo.Worksheets
With ws.PageSetup
.CenterHeader = &#34;&18Facilities Maintenance &#34; & Craft & Space(1) & Interval
.LeftFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Route Completed Form to Group Lead for Processing&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & &#34;Retention: 11yrs&#34;
.CenterFooter = &#34;PROPRIETARY INFORMATION&#34;
.RightFooter = _
&#34;&&#34;&#34;-,Regular&#34;&#34;&11Group Lead Approval___________ Date___________&#34; & Chr(10) & _
&#34;&#34; & Chr(10) & DeptCode & Format(i, &#34;0000&#34;) & &#34;.rev01&#34;
End With
i = i + 1
Next ws
End Sub

[/pre]

Luke M · May 29, 2012

Way to go bobbyd98682! Glad I was able to inspire you. =)

Macro for Auto Inserting a Number Incrementally (+1) in the footer of Excel2010

bobbyd98682

New Member

xld

Member

Hui

Excel Ninja

bobbyd98682

New Member

Luke M

Excel Ninja

bobbyd98682

New Member

bobbyd98682

New Member

Luke M

Excel Ninja

bobbyd98682

New Member

bobbyd98682

New Member

Luke M

Excel Ninja