Macro to print text from a cell in the page footer

[claude jerry]

Hi guys

I have a Worksheet with following format

Col B Col C Col E

FileLink Report Name Prepared By
Link Payroll Tim
Link Banking Sally
Link Housekeep Jerry
Link Vehicles Tim
Link Irrigation Ralph
Finished

Each user does a report and comes to this worksheet and enters his name in
the cell prepared by.
In col B there are hyper links to the files they have created and saved in
the same directory

Once all users complete their task and This above summary file is complete I
use a macro to print the Individual files the users have created with
following macro


Sub PrtRpt()
i = 2
Do Until i = 401
If Cells(i, 2) = "Finished" Then
Exit Sub
ElseIf Cells(i, 2) = "" Then
'Cells(i, 2) = "Blank"
Else
Cells(i, 2).Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWindow.Close

End If
i = i + 1
Loop

End Sub

All this works fine. . I want to Modify my Above macro To Print the Name of
the person who has preapered the file in the footer of the hyperlinked file
(Printouts of the Files printed with the MACRO) as every month the persons
doing the task keeps changing.

Eg for this month. for Payroll Report Footer should be --- Prepared by Tim
For Banking Report Footer should be ---- Prepared by Sally
for housekeeping Report footer should be -- prepared by Jerry

Any Help Please
Claude

 

[Jacob Skaria]

Hi Claude

Modified your macro a bit..

--There is no need to have a cell with "Finished" to exit. Instead the below
macro will loop from row 2 until the last filled row in Column C
--You dont need to select a cell or activate a sheet to assign a footer or
to print
--Try the below and feedback

Sub PrtRpt()

Dim lngRow As Long, strSheet As String
For lngRow = 2 To Cells(Rows.Count, "C").End(xlUp).Row
strSheet = Split(Range("B" & lngRow).Hyperlinks(1).SubAddress, "!")(0)
Sheets(strSheet).PageSetup.RightFooter = "Prepared by" & _
Range("D" & lngRow)
Sheets(strSheet).PrintOut Copies:=1, Collate:=True
Next

End Sub


If this post helps click Yes