[ code]
Sub Graphic2_Click()
'This section checks the income templates to see which income docs to load from the Master to the Doc Checklist:
'Salaried Wage Earner
If Range("B4").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Wage Earner with Bonus
If Range("B5").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Wage Earner + Commission
If Range("B6").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Commission Only
If Range("B7").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Self Employed
If Range("B8").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Fixed Income-Pension
If Range("B9").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Fixed Income- IRA
If Range("B10").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Fixed Income- Social Security
If Range("B11").Value2 = "x" Then Worksheets("Master").Range("B4,B5,B6,B7").Value2 = "x"
'Then add any documents from Master to the Doc Checklist
With Sheets("Master").Range("B2:B100").SpecialCells(xlConstants)
.Offset(, 1).Copy Sheets("Doc Checklist").Range("C2")
End With
On Error Resume Next
Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
'Then this section looks for any other documents on the Doc Request sheet and adds them to the the Doc Checklist
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Dim LSTROW As Integer
Dim bcol As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied
Dim zcol As String
'remove rows with empty cells in column C
On Error Resume Next
Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
With Sheets("Doc Request")
On Error GoTo err_msg
'based on column C we need to find row range to search for mark in column Z. We will return address for copy
bcol = .Range("B15:B500").SpecialCells(xlConstants).Address
Debug.Print bcol
zcol = .Range(bcol).Offset(, 24).Address
Debug.Print zcol
'based on address from srcchk we determine address range of blank cells
On Error GoTo err_msg
cprange = .Range(zcol).SpecialCells(xlBlanks).Address
Debug.Print cprange
'using address from cprange we move selection left by 25 columns and copy data
.Range(cprange).Offset(, -25).Copy
End With
With Worksheets("Doc Checklist")
LSTROW = .Range("C" & .Rows.Count).End(xlUp).Row + 1
'fill next available cell with a new data
.Range("C" & LSTROW).PasteSpecial xlPasteAll
End With
'once again, using cprange we mark rows which have been copied to "Doc Checklist"
With Sheets("Doc Request")
.Range(cprange).Value = "x"
End With
GoTo SkiptoHere
err_msg:
MsgBox "Income Template Documents may have been added, but no additional docs to have been detected."
SkiptoHere:
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Then this copies the entire list from the Doc Checklist back to the Doc Request so the user has an immediate feedback of the list they are creating
Worksheets("Doc Checklist").Range("C2:C100").Copy Worksheets("Doc Request").Range("I4:I100")
'Then Timestamp
Dim TS As Long
Worksheets("Doc Request").Range("I4").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F3").Select
Selection.NumberFormat = "[$-en-US]m/d/yy h:mm AM/PM;@"
End Sub
[/code ]
Its really just that last bit where I strated to DIM TS as Long ...
