To all of those who may be interested, there is also a Function() utilized
in the macro that you may not have.
Place this Function() in the same VBA Module as the above macro.

Dennis

************************************************** ***


Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson via Dave Peterson 7/19/2005
' for Add Worksheet() and PopulateWorksheet()
'
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0)
End Function



"Dennis" wrote:

Dave, (I hope that you read this!)

It took me a while to "perfect" this procedure. Obviously I am not that
good with VBA. Saying that, this procedure and call to another works very
well as intended.

As an accountant, my real work is accounting, audit, and Sarbanes-Oxley
(SOX) tasks. VBA is my hobby.

We SOX people have a number of "Remediation" w/s to be generated from a
result a "Master" control w/s.

It is not pretty, but it does the job and you were the one who gave me
significant clue's.

I would like to share it with others as many of you do for we humbler XL
users.


Thank you again, Dennis

************************************************** **********
Sub ABBPopulateWorksheet()
'
'Source Dave Peterson 7/18/2005 heavily modified 7/29/2005 9:30 AM to
DMB special use
'
'
'This Procedure is Calls Sub ABBOneCellText() and its result is the
variable TextVar
' In order to maintain the Variable TextVar, see two lines below.
'
'NOTE: "Dim TextVar As String" must be placed outside of both related
Sub Routines.
' Place it at the top of this module file
'
If MsgBox("To succesfully run this Macro, these items must be known or
established beforehand: " + Chr(10) _
& " The worksheet with the data to pass into another
worksheet must be the file from which you start" + Chr(10) _
& " the macro. i.e. (must be the active sheet).
This sheet is the DataSourceSheet." + Chr(10) + Chr(10) _
& "Obtain the full file-name AND Sheetname of the Excel
Workbook/Sheet to be the Template format" + Chr(10) _
& "Obtain the full file-name AND Sheetname of the Excel
Workbook/Sheet into which the data will be placed" + Chr(10) + Chr(10) _
& "Also obtain the Column letters of the final Control
definition, Control Owner, Control Number and Risk Number" + Chr(10) +
Chr(10) _
& "ARE YOU READY TO CONTINUE?", vbYesNo, "NOTICE") = vbNo Then
Exit Sub

Dim myOrigSheetProtectStatus As Boolean
Dim DataSourceBook As Workbook 'Data "from" workbook
Dim DataSourceSheet As Worksheet 'Data "from" worksheet
Dim CopyFromBook As Workbook 'Workbook to use as template
Dim CopyFromSheet As Worksheet 'Worksheet to use as template
Dim ReceiveBook As Workbook 'Workbook to be populated
Dim ReceiveSheetName As String 'Worksheet to be populated
Dim DataSourcePath As String 'Path for all files
Dim CopyFromBookName As String 'Workbook to use as template
Dim CopyFromSheetName As String 'Workbook to use as template
Dim CopyFromSheetNameOrig As String 'Workbook to use as template
Dim ReceiveBookName As String 'Workbook to be populated
Dim DataSourceBookName As String 'Data "from" workbook name
Dim DataSourceSheetName As String 'Data "from" worksheet name
Dim VisibleRowsCounter As Long 'Counts visable rows after filtering
Dim VisibleRowsRange As Range 'Range of all Visable Rows
Dim MyCell As Range 'used to ID and select Rows with data
Dim SheetExists As Boolean 'Logical status (existance) of a sheet
Dim ColLtrControlNumber As String 'Column Letter(s) of Control Numbers
Dim ColLtrControlDescrip As String 'Column Letter(s) of Control
Description
Dim ColLtrControlBy As String 'Column Letter(s) of Control Owner
Dim ColLtrRiskNumber As String 'Column Letter(s) of Risk Number
Dim Continue As Boolean
Dim Counter As Long
' Must have the Data source workbook open and the filter ranges set
'
Continue = True
Do While Continue = True
On Error Resume Next
myOrigSheetProtectStatus = ActiveSheet.ProtectContents
If myOrigSheetProtectStatus = True Then
ActiveSheet.Protect UserInterfaceOnly:=True
End If
If Error Then
If MsgBox("There is no Active Worksheet ......... Exiting Routine
..", vbOKOnly, _
"NOTICE") = vbOK Then Exit Sub
End If
Set DataSourceBook = ActiveWorkbook
Set DataSourceSheet = ActiveSheet
'
'Note: Worksheet Tab names are limited to 31 characters. The
process below, adds 7
' characters to the source tab name, (i.e." GAP nn") therefore the
original tab name can not
' exceed 24 characters
'
If Len(DataSourceSheet.Name) 24 Then
MsgBox ("NOTE: The Data-Source Tab Label [" &
DataSourceSheet.Name & _
"] will be truncated to 24 Characters!!")
End If
DataSourceSheetName = Trim(Mid(DataSourceSheet.Name, 1, 24))
DataSourceSheet.Name = DataSourceSheetName
CopyFromSheetName = "GAP Template"
CopyFromSheetNameOrig = "GAP Template"
' Determines the path of the Data source workbook and saves it as a
variable
' to use below
DataSourcePath = DataSourceBook.Path
DataSourceBookName = DataSourceBook.Name
' Opens up the workbook from which the one and only W/S will become
a "template" for use below
DataSourceBookName = InputBox("Enter the complete File Name
including the Extension" & Chr(10) _
& "of the File from which the data will come", ,
DataSourceBookName)
If DataSourceBookName = "" Then
MsgBox "Valid Data not Entered - CANCELLED!"
Exit Sub
End If
ReceiveBookName = InputBox("Enter the complete File Name including
the Extension" & Chr(10) & _
"of the File into which the data will go" & Chr(10) & Chr(10) &
"NOTE: The first Sheet in " & _
"the ReceiveBook will be the Template", , ReceiveBookName)
If ReceiveBookName = "" Then
MsgBox "Valid Data not Entered - CANCELLED!"
Exit Sub
End If
CopyFromBookName = InputBox("Enter the complete File Name including
the Extension" & Chr(10) & _
"of the File ""Template"" to Copy From", , CopyFromBookName)
CopyFromSheetName = InputBox("Enter the SHEET Name to be copied in
the File 'Template' to" & _
"Copy From", , CopyFromSheetName)
Set CopyFromBook = Nothing
On Error Resume Next
Set CopyFromBook = Workbooks(CopyFromBookName)
On Error GoTo 0
If CopyFromBook Is Nothing Then
Set CopyFromBook = Workbooks.Open(fileName:=DataSourcePath & "\"
& CopyFromBookName)
End If
Set ReceiveBook = Nothing
On Error Resume Next
Set ReceiveBook = Workbooks(ReceiveBookName)
On Error GoTo 0
If ReceiveBook Is Nothing Then
Set ReceiveBook = Workbooks.Open(fileName:=DataSourcePath &
"\" & ReceiveBookName)
If Error Then
Workbooks.Add
Workbooks("Book1").SaveAs (DataSourcePath & "\" &
ReceiveBookName)
End If
On Error GoTo 0
End If
' ReceiveBook should have THE FIRST sheet cloned as a template.
DataSourceBook.Activate
DataSourceSheet.Activate
On Error Resume Next
With DataSourceSheet.AutoFilter.Range
Set VisibleRowsRange = Nothing
On Error Resume Next
Set VisibleRowsRange = .Columns(1).Cells.Resize(.Rows.count - 1,
1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If VisibleRowsRange Is Nothing Then
'only the header is visible
MsgBox " No filtered details
shown !!!" + Chr(10) + Chr(10) + _
"The Template W/S must be Active when you start this Macro"
+ Chr(10) + _
"Also make sure that AutoFilter is actively filtering one
Column"
Else
VisibleRowsCounter = 0
' Note: the range is one-cell wide. Thus VisibleRowsCounter
will increment until = number of rows
For Each MyCell In VisibleRowsRange.Cells
VisibleRowsCounter = VisibleRowsCounter + 1
Dim WSName As String
WSName = DataSourceSheetName & " GAP " &
VisibleRowsCounter
If WorksheetExists(WSName, ReceiveBook) Then
If MsgBox("Be aware that you may be duplicating
worksheets!" + Chr(10) & Chr(10) & _
"Do you wish to Continue?", vbYesNo) = vbNo Then
Exit Sub
CopyFromSheetName = WSName
Else
If WorksheetExists("GAP Template", ReceiveBook) Then
CopyFromSheetName = "GAP Template"
' Do not wish to count the Template w/s
VisibleRowsCounter = VisibleRowsCounter - 1
Else
MsgBox ("Add a Worksheet to Copy From and Name
it 'GAP Template'")
Exit Sub
End If
End If
ReceiveBook.Worksheets.Add
After:=ReceiveBook.Worksheets(ReceiveBook.Sheets.c ount)
VisibleRowsCounter = VisibleRowsCounter + 1
NewSheetName = ReceiveBook.ActiveSheet.Name
ReceiveBook.Sheets(NewSheetName).Activate
Counter = VisibleRowsCounter
'This loop checks if there is a worksheet with the same
name
Do While WorksheetExists(DataSourceSheetName & " GAP " &
Counter, ReceiveBook)
Counter = Counter + 1
Loop
ReceiveBook.Sheets(NewSheetName).Name =
DataSourceSheetName & " GAP " & Counter
ReceiveSheetName = DataSourceSheetName & " GAP " & Counter
' On Error Resume Next
ReceiveBook.ActiveSheet.Name = ReceiveSheetName
CopyFromBook.Worksheets(CopyFromSheetName).Activat e
Cells.Copy
ReceiveBook.Worksheets(ReceiveSheetName).Activate
ReceiveBook.Worksheets(ReceiveSheetName).Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ReceiveBook.Worksheets(ReceiveSheetName).Paste
CopyFromBook.Worksheets(CopyFromSheetName).Activat e
Cells.Copy
ReceiveBook.Worksheets(ReceiveSheetName).Activate
ReceiveBook.Worksheets(ReceiveSheetName).Select
Cells.Select
ReceiveBook.Worksheets(ReceiveSheetName).Paste
Application.CutCopyMode = False
DataSourceBook.Activate
If VisibleRowsCounter < 3 Then
ColLtrControlNumber = Trim(InputBox("Control
Number", "Enter Column Letter(s) of:", "K"))
ColLtrControlDescrip = Trim(InputBox("Actual
Control", "Enter Column Letter(s) of:", "L"))
ColLtrControlBy = Trim(InputBox("Control Performed
By", "Enter Column Letter(s) of:", "O"))
ColLtrRiskNumber = Trim(InputBox("Risk Number",
"Enter Column Letter(s) of:", "G"))
End If
Sheets(1).Activate
Call ABBOneCellText
ReceiveBook.Worksheets(ReceiveSheetName).Activate
ActiveSheet.Range("A4").Value = Mid(DataSourceBookName,
1, 12)
ActiveSheet.Range("A4").Font.ColorIndex = 5
ActiveSheet.Range("A6").Value = TextVar
ActiveSheet.Range("A6").Font.ColorIndex = 5
ActiveSheet.Range("A8").Formula = "=MID('[" &
DataSourceBookName & "]" & _
DataSourceSheetName & "'!" & ColLtrControlNumber &
MyCell.Cells.Row & ",1,1)" '
ActiveSheet.Range("A8").Font.ColorIndex = 5
ActiveSheet.Range("A10").Formula = "='[" &
DataSourceBookName & "]" & _
DataSourceSheetName & "'!" & ColLtrControlDescrip &
MyCell.Cells.Row
ActiveSheet.Range("A10").Font.ColorIndex = 5
ActiveSheet.Range("D4").Value = Mid(Now(), 1, 10)
ActiveSheet.Range("D4").Font.ColorIndex = 5
ActiveSheet.Range("F4").Formula = "='[" &
DataSourceBookName & "]" & _
DataSourceSheetName & "'!" & ColLtrControlBy &
MyCell.Cells.Row
ActiveSheet.Range("F4").Font.ColorIndex = 5
ActiveSheet.Range("F8").Formula = "='[" &
DataSourceBookName & "]" & _
DataSourceSheetName & "'!" & ColLtrRiskNumber &
MyCell.Cells.Row
ActiveSheet.Range("F8").Font.ColorIndex = 5
ActiveSheet.Range("I4").Formula = "='[" &
DataSourceBookName & "]" & _
DataSourceSheetName & "'!" & ColLtrControlNumber &
MyCell.Cells.Row
ActiveSheet.Range("I4").Font.ColorIndex = 5
ReceiveBook.Worksheets(ReceiveSheetName).Select
Cells.Select
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
Range("A1").Select
Next MyCell
End If
End With
If myOrigSheetProtectStatus = True Then
DataSourceSheet.Protect UserInterfaceOnly:=False
End If
If MsgBox("Press YES to Continue Processing Sheets", vbYesNo) = vbNo