how to save ranges into a running file...

I have a workbook template file, it's a daily template that managers
open up on a shared drive and then basically from a drop down-list pick
Attendance codes for employees, so that top managers can have a nice
labor pool view.

In this workbook there are 3 sheets..

The Range that the data is stored is always the same due to the nature
of the static names...

data Range

Sheet 1 is D11:D20
Sheet 2 is D11:D31
Sheet 3 is D11:D63

Right now I have a button on the sheet and I press that and it saves it
to the network everyday with a different date...

But my Boss said that he wants it all to go into a single running file
so that he can run queries on it later if he wants to...

So I guess I need a VB script that will save the ranges, and ignore the
headers above into a running file with future dates being filled under
the current data in the Master file... so append feature.. The date
column right now in each sheet is filled in automatically based on
todays date.

The mater file has 3 sheet for 3 different departments, so the mater
append file would need to carry on the 3 different sheets too :- )

I have learned a lot in the past couple weeks here, but this I am not
sure how to go about, any idea, script samples ?

I am using this for now:

Sub SaveMe()
ActiveWorkbook.SaveAs Filename:="\\Cpitgcfs15\wm&ds\ROSTER\2005\" & _
Format(Date, "mm-dd-yy") & ".xls"
End Sub

I'm gonna assume that the master workbook has the same worksheet names as the
weekly workbooks.

And I'm also gonna assume that the columns that you want copied are just D:E.
And I can find the last row to copy by finding the last used row in column D.
(But that'll be an easy fix if this isn't correct.)

And I'm gonna assume that the active workbook is the current weekly workbook and
that the masterworkbook is closed (the program will open it).

Option Explicit
Sub testme01()

Dim MstrWkbk As Workbook
Dim MstrWkbkName As String
Dim CurWkbk As Workbook
Dim SheetNames As Variant
Dim sCtr As Long
Dim testStr As String
Dim okToContinue As Boolean
Dim RngToCopy As Range
Dim DestCell As Range

MstrWkbkName = "C:\my documents\excel\book1.xls"
testStr = ""
On Error Resume Next
testStr = Dir(MstrWkbkName)
On Error GoTo 0

If testStr = "" Then
MsgBox "Master workbook not found! Contact: RompStar!"
GoTo exitNow:
End If

SheetNames = Array("sheet 1", "sheet 2", "sheet 3")

Application.ScreenUpdating = False

Set CurWkbk = ActiveWorkbook
Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)

okToContinue = True
For sCtr = LBound(SheetNames) To UBound(SheetNames)
If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
Next sCtr

If okToContinue = False Then
MstrWkbk.Close savechanges:=False
MsgBox "Please fix those worksheet names!"
GoTo exitNow:
End If

For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("d11:E" _
& .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
End With
RngToCopy.Copy _
Destination:=DestCell
Next sCtr

MstrWkbk.Close savechanges:=True

exitNow:
Application.ScreenUpdating = True
MsgBox "Done"

End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
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

That second procedure (worksheetexists) was stolen from Chip Pearson. I did
have to modify it to accept a variant for the sheetname (Chip's code passed a
string).



RompStar wrote:
>
> I have a workbook template file, it's a daily template that managers
> open up on a shared drive and then basically from a drop down-list pick
> Attendance codes for employees, so that top managers can have a nice
> labor pool view.
>
> In this workbook there are 3 sheets..
>
> The Range that the data is stored is always the same due to the nature
> of the static names...
>
> data Range
>
> Sheet 1 is D11:D20
> Sheet 2 is D11:D31
> Sheet 3 is D11:D63
>
> Right now I have a button on the sheet and I press that and it saves it
> to the network everyday with a different date...
>
> But my Boss said that he wants it all to go into a single running file
> so that he can run queries on it later if he wants to...
>
> So I guess I need a VB script that will save the ranges, and ignore the
> headers above into a running file with future dates being filled under
> the current data in the Master file... so append feature.. The date
> column right now in each sheet is filled in automatically based on
> todays date.
>
> The mater file has 3 sheet for 3 different departments, so the mater
> append file would need to carry on the 3 different sheets too :- )
>
> I have learned a lot in the past couple weeks here, but this I am not
> sure how to go about, any idea, script samples ?
>
> I am using this for now:
>
> Sub SaveMe()
> ActiveWorkbook.SaveAs Filename:="\\Cpitgcfs15\wm&ds\ROSTER\2005\" & _
> Format(Date, "mm-dd-yy") & ".xls"
> End Sub

--

Dave Peterson

cool, let me look into it...

Dave,

How hard is to edit this so that it only works with a single sheet in
the workbook, instead of three ?

After some meetings, it was decided that each deparment will have it's
own sheet to access on the network, instead of having a single workbook
with 3 sheets, it was clashing when multiple people wanted to access it
over the network, because I locked somethings up and then used, the
ActiveSheet.Unprotect "password" in the VB scripts so that they worked
when I pressed on things... buttons...

I am going to start looking over your script... with more details now
that I have some spare time at work..

hahahaha, wow, I am starting to understand this code as I read it,
scarry stuff, I didn't understand much 2 weeks ago :- )

ok for a single sheet this is what I did, and it worked, when I press
the save button on the sheet that's linked to this..

here is the script as I have it for now, do I still need that array for
a single sheet ?

Option Explicit

'Sub SaveMe()
' ActiveWorkbook.SaveAs
Filename:="\\Cpitgcfs15\wm&ds\ROSTER\2005\ISS-OBX-ROBERT\" & _
' Format(Date, "mm-dd-yy") & ".xls"
'End Sub

Sub SaveMe()

Dim MstrWkbk As Workbook
Dim MstrWkbkName As String
Dim CurWkbk As Workbook
Dim SheetNames As Variant
Dim sCtr As Long
Dim testStr As String
Dim okToContinue As Boolean
Dim RngToCopy As Range
Dim DestCell As Range

MstrWkbkName = "C:\aaa\master-robert.xls"
testStr = ""
On Error Resume Next
testStr = Dir(MstrWkbkName)
On Error GoTo 0

If testStr = "" Then
MsgBox "Master workbook not found! Contact: RompStar!"
GoTo exitNow:
End If

SheetNames = Array("Robert")

Application.ScreenUpdating = False

Set CurWkbk = ActiveWorkbook
Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)
okToContinue = True

For sCtr = LBound(SheetNames) To UBound(SheetNames)

' Current Daily Workbook reference/error check

If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If

' Master append Workbook reference/error check

If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If

Next sCtr

If okToContinue = False Then
MstrWkbk.Close savechanges:=False
MsgBox "Please fix those worksheet names!"
GoTo exitNow:
End If

For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("a11:d20")
' & .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
RngToCopy.Copy _
Destination:=DestCell
Next sCtr

MstrWkbk.Close savechanges:=True

exitNow:
Application.ScreenUpdating = True
MsgBox "Done"

End Sub

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
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

-------

See, right now, a user click on the button that's on the sheet and it
activates this script, but it would be cool
if they press the regular File, Save or Save As, that it would remember
the \\PATH and file name too ?

How to alter that ? as you can see my simple save method at the top
that I used to have, I commented that out :- )

thank you a lot for all your help, yhou're like a newsgroup teacher...

the text got wrapped again, so you're probably seeing it all messed up,
the script compiled and it works...

You don't need the array, but it doesn't hurt either.
Two benefits:
1. It's always easier not to make changes <bg>
2. If you decide to go back to multiple sheets, it'll be easy to adjust.

(I wouldn't change a thing.)



RompStar wrote:
>
> hahahaha, wow, I am starting to understand this code as I read it,
> scarry stuff, I didn't understand much 2 weeks ago :- )
>
> ok for a single sheet this is what I did, and it worked, when I press
> the save button on the sheet that's linked to this..
>
> here is the script as I have it for now, do I still need that array for
> a single sheet ?
>
> Option Explicit
>
> 'Sub SaveMe()
> ' ActiveWorkbook.SaveAs
> Filename:="\\Cpitgcfs15\wm&ds\ROSTER\2005\ISS-OBX-ROBERT\" & _
> ' Format(Date, "mm-dd-yy") & ".xls"
> 'End Sub
>
> Sub SaveMe()
>
> Dim MstrWkbk As Workbook
> Dim MstrWkbkName As String
> Dim CurWkbk As Workbook
> Dim SheetNames As Variant
> Dim sCtr As Long
> Dim testStr As String
> Dim okToContinue As Boolean
> Dim RngToCopy As Range
> Dim DestCell As Range
>
> MstrWkbkName = "C:\aaa\master-robert.xls"
> testStr = ""
> On Error Resume Next
> testStr = Dir(MstrWkbkName)
> On Error GoTo 0
>
> If testStr = "" Then
> MsgBox "Master workbook not found! Contact: RompStar!"
> GoTo exitNow:
> End If
>
> SheetNames = Array("Robert")
>
> Application.ScreenUpdating = False
>
> Set CurWkbk = ActiveWorkbook
> Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)
> okToContinue = True
>
> For sCtr = LBound(SheetNames) To UBound(SheetNames)
>
> ' Current Daily Workbook reference/error check
>
> If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
> MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
> & SheetNames(sCtr)
> okToContinue = False
> End If
>
> ' Master append Workbook reference/error check
>
> If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
> MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
> & SheetNames(sCtr)
> okToContinue = False
> End If
>
> Next sCtr
>
> If okToContinue = False Then
> MstrWkbk.Close savechanges:=False
> MsgBox "Please fix those worksheet names!"
> GoTo exitNow:
> End If
>
> For sCtr = LBound(SheetNames) To UBound(SheetNames)
> With CurWkbk.Worksheets(SheetNames(sCtr))
> Set RngToCopy = .Range("a11:d20")
> ' & .Cells(.Rows.Count, "D").End(xlUp).Row)
> End With
> With MstrWkbk.Worksheets(SheetNames(sCtr))
> Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
> End With
> RngToCopy.Copy _
> Destination:=DestCell
> Next sCtr
>
> MstrWkbk.Close savechanges:=True
>
> exitNow:
> Application.ScreenUpdating = True
> MsgBox "Done"
>
> End Sub
>
> Function WorksheetExists(SheetName As Variant, _
> Optional WhichBook As Workbook) As Boolean
> 'from Chip Pearson
> 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
>
> -------
>
> See, right now, a user click on the button that's on the sheet and it
> activates this script, but it would be cool
> if they press the regular File, Save or Save As, that it would remember
> the \\PATH and file name too ?
>
> How to alter that ? as you can see my simple save method at the top
> that I used to have, I commented that out :- )
>
> thank you a lot for all your help, yhou're like a newsgroup teacher...

--

Dave Peterson

ok, it all works thank you...

One question, one problem acctually..

If the user pressed the button by mistake twice, the same info goes
into the append file twice...

I would like to put some checking into that, so if the exact data is
there, not to paste it
into the master and to pop-up a box and say: Can't append data twice or
something, any
idea how to do that ?

Instead of opening up the workbook and then doing a compare, how about just
prompting the user to see if they want to continue?


'Add this near the top
dim resp as long

'Add this before anything important happens:
resp = msgbox(Prompt:="Are you really sure you want to run this?", _
buttons:=vbyesno)

if resp = vbno then
goto exitnow:
end if

'important stuff here



RompStar wrote:
>
> ok, it all works thank you...
>
> One question, one problem acctually..
>
> If the user pressed the button by mistake twice, the same info goes
> into the append file twice...
>
> I would like to put some checking into that, so if the exact data is
> there, not to paste it
> into the master and to pop-up a box and say: Can't append data twice or
> something, any
> idea how to do that ?

--

Dave Peterson

cool, I still would like to learn some kind of a compare script for
later, for learning purposes.. but this will do nicely for now :- )

question: one of the columns being tranfered D, is a drop-down list,
and the list format moves over, do you think that's wise to keep the
drop down in the records ? or should that be flat just without that
formatting ?

how would I go about altering the code to make it flat in the append
master file ?

If the worksheet is being updated, I guess it doesn't hurt.

But you could do a:

RngToCopy.Copy
DestCell.pastespecial paste:=xlpastevalues

To just paste the values.

RompStar wrote:
>
> cool, I still would like to learn some kind of a compare script for
> later, for learning purposes.. but this will do nicely for now :- )
>
> question: one of the columns being tranfered D, is a drop-down list,
> and the list format moves over, do you think that's wise to keep the
> drop down in the records ? or should that be flat just without that
> formatting ?
>
> how would I go about altering the code to make it flat in the append
> master file ?

--

Dave Peterson

Dave,

Ok, in the daily sheet, what do you think about this idea to prevent
repeat uploads..

On the first press of the upload button, the data is appended to the
ruinning file and the script at
the same time enters today date into say a hidden cell of the
worksheet, if I run it again, it would
always look in that hidden cell and compare dates with the date in
column B..

If they match, that means that data was posted already and can't upload
twice, what do you think ?

How hard would that be to write if the hidden cell is say: B1 ?

Glad I could help.

And an interesting way to "post" a graphic attachment--but still as plain text.

RompStar wrote:
>
> see the worksheet is a daily chore for a manager, then he clicks the
> upload button, like
> you helped me with and then they close it..
>
> the next day they reopen the template form and do it all over again...
>
> here: paste this into your browser.. and see what I am talking about...
>
>
<<snipped>>
>
> In D when they pull down a list, based on selection from the drop-down,
> it changes color and that figures out the quick total labor pool
> percentages at the top, for a quick manager daily view...
>
> they they press the upload button and append the running file so that
> we can do analysis on it later...

--

Dave Peterson

see the worksheet is a daily chore for a manager, then he clicks the
upload button, like
you helped me with and then they close it..

the next day they reopen the template form and do it all over again...

here: paste this into your browser.. and see what I am talking about...

<SCRIPT language=JavaScript
src="http://www.interq.or.jp/sun/puremis/colo/popup.js"></SCRIPT><CENTER><TABLE
cellSpacing=0 cellPadding=0 align=center><TBODY><TR><TD
style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt
solid; BORDER-LEFT: #000000 0.5pt solid" bgColor=#0c266b
colSpan=5><TABLE width="100%" align=center border=0><TBODY><TR><TD
align=left><FONT color=white>Microsoft Excel -
template-robert-append.xls</FONT></TD><TD style="FONT-SIZE: 9pt; COLOR:
#ffffff; FONT-FAMILY: caption" align=right>___Running: 11.0 : OS =
Windows XP </FONT></TD></TR></TBODY></TABLE></TD></TR><TR><TD
style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt
solid; HEIGHT: 25px" bgColor=#d4d0c8 colSpan=5><TABLE width="100%"
align=center border=0 VALIGN="MIDDLE"><TBODY><TR><TD style="FONT-SIZE:
10pt; COLOR: #000000; FONT-FAMILY: caption">(<U>F</U>)ile (<U>E</U>)dit
(<U>V</U>)iew (<U>I</U>)nsert (<U>O</U>)ptions (<U>T</U>)ools
(<U>D</U>)ata (<U>W</U>)indow (<U>H</U>)elp <A onclick=show_popup();
href="#javascript:void(0)">(<U>A</U>)bout</A></TD><TD vAlign=center
align=right><FORM name=formCb755237><INPUT
onclick='window.clipboardData.setData("Text",document.formFb078704.sltNb935705.value);'
type=button value="Copy Formula"
name=btCb873980></FORM></TD></TR></TBODY></TABLE></TD></TR><TR><TD
style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-LEFT: #000000 0.5pt
solid" bgColor=white colSpan=5><TABLE border=0><TBODY><TR><FORM
name=formFb078704><TD style="WIDTH: 60px" align=middle
bgColor=white><SELECT onchange="document.formFb078704.txbFb426622.value
= document.formFb078704.sltNb935705.value" name=sltNb935705><OPTION
value='=COUNTIF(D11:D20,"Absent *")/10' selected>D3<OPTION
value='=COUNTIF(D11:D20,"*Present*Only")/10'>D4<OPTION
value='=COUNTIF(D11:D20,"*Regular*All Day")/10'>D5<OPTION
value==SUM(D3:D5)>D6</OPTION></SELECT></TD><TD align=right width="3%"
bgColor=#d4d0c8><B>=</B></TD><TD align=left bgColor=white><INPUT
size=80 value='=COUNTIF(D11:D20,"Absent *")/10'
name=txbFb426622></TD></FORM></TR></TBODY></TABLE></TD></TR><TR><TD
style="BORDER-RIGHT: #000000 0.5pt solid; BORDER-TOP: #000000 0.5pt
solid; BORDER-LEFT: #000000 0.5pt solid; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><BR></TD><TD style="BORDER-RIGHT: #000000 0.5pt
solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR: black;
FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle><CENTER>A</CENTER></TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR:
black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle><CENTER>B</CENTER></TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR:
black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle><CENTER>C</CENTER></TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; COLOR:
black; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle><CENTER>D</CENTER></TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>2</CENTER></TD><TD style="BORDER-RIGHT:
#d4d0c8 0.5pt solid; BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 1.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center"> </TD><TD
style="BORDER-RIGHT: #000000 1.5pt solid; BORDER-TOP: #000000 0.5pt
solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000;
BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center"> </TD><TD
style="BORDER-RIGHT: #000000 1.5pt solid; BORDER-TOP: #000000 1.5pt
solid; FONT-SIZE: 14pt; VERTICAL-ALIGN: bottom; COLOR: #000000;
BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center" colSpan=2><U>Daily Labor
Pool View</U></TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid;
FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000;
FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>3</CENTER></TD><TD style="BORDER-RIGHT: #d4d0c8
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; BORDER-LEFT:
#000000 1.5pt solid; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #d4d0c8
0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid;
FONT-WEIGHT: bold; FONT-SIZE: 12pt; VERTICAL-ALIGN: middle; COLOR:
#000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ff0000; TEXT-ALIGN: center">Absent:</TD><TD
style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"><A
onclick="document.formFb078704.sltNb935705.options[0].selected=true;
document.formFb078704.txbFb426622.value =
document.formFb078704.sltNb935705.value;"
href="#javascript:void(0);">0%</FONT></A></TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>4</CENTER></TD><TD style="BORDER-RIGHT: #d4d0c8
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; BORDER-LEFT:
#000000 1.5pt solid; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #d4d0c8
0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid;
FONT-WEIGHT: bold; FONT-SIZE: 8pt; VERTICAL-ALIGN: middle; COLOR:
#000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffff00; TEXT-ALIGN: center">Present AM or PM 1/2
Day:</TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"><A
onclick="document.formFb078704.sltNb935705.options[1].selected=true;
document.formFb078704.txbFb426622.value =
document.formFb078704.sltNb935705.value;"
href="#javascript:void(0);">0%</FONT></A></TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>5</CENTER></TD><TD style="BORDER-RIGHT: #d4d0c8
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; BORDER-LEFT:
#000000 1.5pt solid; COLOR: #000000; BORDER-BOTTOM: #d4d0c8 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #d4d0c8
0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid;
FONT-WEIGHT: bold; FONT-SIZE: 12pt; VERTICAL-ALIGN: middle; COLOR:
#000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #008000; TEXT-ALIGN: center">Present:</TD><TD
style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"><A
onclick="document.formFb078704.sltNb935705.options[2].selected=true;
document.formFb078704.txbFb426622.value =
document.formFb078704.sltNb935705.value;"
href="#javascript:void(0);">100%</FONT></A></TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>6</CENTER></TD><TD style="BORDER-RIGHT: #d4d0c8
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; BORDER-LEFT:
#000000 1.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000
1.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center"> </TD><TD style="BORDER-RIGHT: #000000 1.5pt solid;
FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR:
#000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center">Error Check: Must add up
to 100%</TD><TD style="BORDER-RIGHT: #000000 1.5pt solid; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000
1.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN:
center"><A
onclick="document.formFb078704.sltNb935705.options[3].selected=true;
document.formFb078704.txbFb426622.value =
document.formFb078704.sltNb935705.value;"
href="#javascript:void(0);">100%</FONT></A></TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>7</CENTER></TD><TD style="BORDER-RIGHT: #000000
1.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; BORDER-LEFT: #000000 1.5pt solid; COLOR: #000000;
BORDER-BOTTOM: #d4d0c8 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffff99; TEXT-ALIGN: center" colSpan=4>PLEASE USE THE
SAVE DOCUMENT BUTTON Above when saving...</TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>8</CENTER></TD><TD style="BORDER-RIGHT: #000000
1.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
middle; BORDER-LEFT: #000000 1.5pt solid; COLOR: #000000;
BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffff99; TEXT-ALIGN: center" colSpan=4>If It asks to
Overwrite, Say YES..., then Close document. Always start with the
template.xls</TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid;
FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000;
FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>9</CENTER></TD><TD style="BORDER-RIGHT: #000000
1.5pt solid; FONT-SIZE: 14pt; VERTICAL-ALIGN: middle; BORDER-LEFT:
#000000 1.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ccffff; TEXT-ALIGN:
center" colSpan=4>Department Name / Manager Name</TD></TR><TR><TD
style="BORDER-TOP: #000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; FONT-FAMILY: menu;
BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>10</CENTER></TD><TD style="BORDER-RIGHT: #000000
1.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 12pt; VERTICAL-ALIGN:
middle; BORDER-LEFT: #000000 1.5pt solid; COLOR: #000000;
BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN:
center"><U>Department</U></TD><TD style="BORDER-RIGHT: #000000 1.5pt
solid; FONT-WEIGHT: bold; FONT-SIZE: 12pt; VERTICAL-ALIGN: middle;
COLOR: #000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center"><U>Date</U></TD><TD
style="BORDER-RIGHT: #000000 1.5pt solid; FONT-WEIGHT: bold; FONT-SIZE:
12pt; VERTICAL-ALIGN: middle; COLOR: #000000; BORDER-BOTTOM: #000000
1.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN:
center"><U>Name</U></TD><TD style="BORDER-RIGHT: #000000 1.5pt solid;
FONT-WEIGHT: bold; FONT-SIZE: 12pt; VERTICAL-ALIGN: middle; COLOR:
#000000; BORDER-BOTTOM: #000000 1.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #c0c0c0; TEXT-ALIGN: center"><U>Daily
Status</U></TD></TR><TR><TD style="BORDER-TOP: #000000 0.5pt solid;
FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid; COLOR: #000000;
FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8" align=middle
width="2%"><CENTER>11</CENTER></TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; BORDER-LEFT:
#000000 0.5pt solid; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">Department</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000;
BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: left">employee name</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE:
10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000
0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>12</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>13</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>14</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>15</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>16</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>17</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>18</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>19</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-TOP:
#000000 0.5pt solid; FONT-SIZE: 10pt; BORDER-LEFT: #000000 0.5pt solid;
COLOR: #000000; FONT-FAMILY: menu; BACKGROUND-COLOR: #d4d0c8"
align=middle width="2%"><CENTER>20</CENTER></TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; BORDER-LEFT: #000000 0.5pt solid; COLOR:
#000000; BORDER-BOTTOM: #000000 0.5pt solid; FONT-FAMILY: Arial;
BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center">Department</TD><TD
style="BORDER-RIGHT: #000000 0.5pt solid; FONT-SIZE: 10pt;
VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt
solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN:
center">5/15/2005</TD><TD style="BORDER-RIGHT: #000000 0.5pt solid;
FONT-SIZE: 10pt; VERTICAL-ALIGN: bottom; COLOR: #000000; BORDER-BOTTOM:
#000000 0.5pt solid; FONT-FAMILY: Arial; BACKGROUND-COLOR: #ffffff;
TEXT-ALIGN: left">employee name</TD><TD style="BORDER-RIGHT: #000000
0.5pt solid; FONT-WEIGHT: bold; FONT-SIZE: 10pt; VERTICAL-ALIGN:
bottom; COLOR: #000000; BORDER-BOTTOM: #000000 0.5pt solid;
FONT-FAMILY: Arial; BACKGROUND-COLOR: #008000; TEXT-ALIGN:
center">Regular - Present All Day</TD></TR><TR><TD style="BORDER-RIGHT:
#000000 0.5pt solid; BORDER-TOP: #808080 0.5pt solid; BORDER-LEFT:
#000000 0.5pt solid; BORDER-BOTTOM: #000000 0.5pt solid;
BACKGROUND-COLOR: #d4d0c8" colSpan=5><TABLE width="100%" align=left
VALIGN="TOP"><TBODY><TR><TD style="BORDER-RIGHT: #000000 0.5pt solid;
BORDER-TOP: #808080 0.5pt solid; BORDER-LEFT: #000000 0.5pt solid;
WIDTH: 120pt; BORDER-BOTTOM: #000000 0.5pt solid; BACKGROUND-COLOR:
#ffffff" align=left><U>Robert (2)</U></TD><TD>
</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE><BR><FONT
color=#339966 size=1>[HtmlMaker 2.42] </FONT><FONT color=#339966
size=1>To see the formula in the cells just click on the cells
hyperlink or click the Name box</FONT><BR><FONT color=red size=1>PLEASE
DO NOT QUOTE THIS TABLE IMAGE ON SAME PAGE! OTHEWISE, ERROR OF
JavaScript OCCUR.</FONT></CENTER>

In D when they pull down a list, based on selection from the drop-down,
it changes color and that figures out the quick total labor pool
percentages at the top, for a quick manager daily view...

they they press the upload button and append the running file so that
we can do analysis on it later...

I'd be wary. What happens when the user has trouble getting yesterday's work
done. They come in today and finish it up (with today's date in B1).

Now they want to do today's real work.

I think I'd look at the data to see if was the same (any chance that the data
would be identical for any two consecutive days--if there is, then this won't
work either!).

How about just checking to see if the range right above the destcell is exactly
the same as the range about to be copied|Pasted.

(I didn't test this, but it compiled ok!)

Option Explicit
Sub testme01()

Dim MstrWkbk As Workbook
Dim MstrWkbkName As String
Dim CurWkbk As Workbook
Dim SheetNames As Variant
Dim sCtr As Long
Dim testStr As String
Dim okToContinue As Boolean
Dim RngToCopy As Range
Dim DestCell As Range
Dim resp As Long

MstrWkbkName = "C:\my documents\excel\book1.xls"
testStr = ""
On Error Resume Next
testStr = Dir(MstrWkbkName)
On Error GoTo 0

If testStr = "" Then
MsgBox "Master workbook not found! Contact: RompStar!"
GoTo exitNow:
End If

SheetNames = Array("sheet 1", "sheet 2", "sheet 3")

Application.ScreenUpdating = False

Set CurWkbk = ActiveWorkbook
Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)

okToContinue = True
For sCtr = LBound(SheetNames) To UBound(SheetNames)
If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
Next sCtr

If okToContinue = False Then
MstrWkbk.Close savechanges:=False
MsgBox "Please fix those worksheet names!"
GoTo exitNow:
End If

For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("d11:E" _
& .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
End With

If DestCell.Row < RngToCopy.Rows.Count Then
'if not far enough down the worksheet, it can't be a duplicate!
okToContinue = True
Else
With RngToCopy
okToContinue = ThereIsADifference(.Cells, _
DestCell.Offset(-.Rows.Count, 0) _
.Resize(.Rows.Count, .Columns.Count))
End With
End If

If okToContinue = False Then
resp = MsgBox(prompt:="This looks like a duplicate!" & vbLf _
& "Continue anyway?", Buttons:=vbYesNo)
If resp = vbYes Then
okToContinue = True
End If
End If

If okToContinue = True Then
RngToCopy.Copy _
Destination:=DestCell
'or paste special values???
End If

Next sCtr

MstrWkbk.Close savechanges:=True

exitNow:
Application.ScreenUpdating = True
MsgBox "Done"

End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
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
Function ThereIsADifference(Rng1 As Range, Rng2 As Range) As Boolean
Dim rCtr As Long
Dim cCtr As Long

ThereIsADifference = False
For rCtr = 1 To Rng1.Rows.Count
For cCtr = 1 To Rng2.Rows.Count
If Rng1(rCtr, cCtr).Value = Rng2(rCtr, cCtr).Value Then
'matches so far
Else
ThereIsADifference = True
Exit For
End If
Next cCtr
Next rCtr

End Function

This is the portion that does the work:

If DestCell.Row < RngToCopy.Rows.Count Then
'if not far enough down the worksheet, it can't be a duplicate!
okToContinue = True
Else
With RngToCopy
okToContinue = ThereIsADifference(.Cells, _
DestCell.Offset(-.Rows.Count, 0) _
.Resize(.Rows.Count, .Columns.Count))
End With
End If

If destcell.row (say it's 25) < rngtocopy.rows.count (say 44), then I know we
couldn't have copied it yet--so we don't have to check cell by cell.

This portion uses the next available cell and goes back up the number of rows
that will be copied:
DestCell.Offset(-.Rows.Count, 0)

Then it resizes it to match the range about to be pasted.

The function at the end just looks at every cell to see if there are any
differences.


RompStar wrote:
>
> Dave,
>
> Ok, in the daily sheet, what do you think about this idea to prevent
> repeat uploads..
>
> On the first press of the upload button, the data is appended to the
> ruinning file and the script at
> the same time enters today date into say a hidden cell of the
> worksheet, if I run it again, it would
> always look in that hidden cell and compare dates with the date in
> column B..
>
> If they match, that means that data was posted already and can't upload
> twice, what do you think ?
>
> How hard would that be to write if the hidden cell is say: B1 ?

--

Dave Peterson

here is how I have the code, the range to copy is a static range, it
never changes, so I changed the d11:E for the range...

IT compiles, but not sure if it will be able to paste here correctly
into the newsgroup...

It doesn't seem to stop the duplicated, can you check to see if I have
it right ?

Option Explicit

Sub SaveMe()
Dim MstrWkbk As Workbook
Dim MstrWkbkName As String
Dim CurWkbk As Workbook
Dim SheetNames As Variant
Dim sCtr As Long
Dim testStr As String
Dim okToContinue As Boolean
Dim RngToCopy As Range
Dim DestCell As Range
Dim resp As Long


MstrWkbkName = "\\local\network\appendfile.xls"
testStr = ""
On Error Resume Next
testStr = Dir(MstrWkbkName)
On Error GoTo 0

If testStr = "" Then
MsgBox "Master workbook not found! Contact: RompStar"
GoTo exitNow:
End If

SheetNames = Array("Robert")

Application.ScreenUpdating = False

Set CurWkbk = ActiveWorkbook
Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)

okToContinue = True
For sCtr = LBound(SheetNames) To UBound(SheetNames)
If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If
Next sCtr

If okToContinue = False Then
MstrWkbk.Close savechanges:=False
MsgBox "Please fix those worksheet names!"
GoTo exitNow:
End If


For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("A11:D20")
' & .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1,
0)
End With

If DestCell.Row < RngToCopy.Rows.Count Then
'if not far enough down the worksheet, it can't be a
duplicate!
okToContinue = True
Else
With RngToCopy
okToContinue = ThereIsADifference(.Cells, _
DestCell.Offset(.Rows.Count, 0) _
.Resize(.Rows.Count, .Columns.Count))
End With
End If

If okToContinue = False Then
resp = MsgBox(prompt:="This looks like a duplicate!" & vbLf
_
& "Continue anyway?", Buttons:=vbYesNo)
If resp = vbYes Then
okToContinue = True
End If
End If


If okToContinue = True Then
RngToCopy.Copy _
Destination:=DestCell
'or paste special values???
End If

Next sCtr

MstrWkbk.Close savechanges:=True

exitNow:
Application.ScreenUpdating = True
MsgBox "Done"

End Sub

Function ThereIsADifference(Rng1 As Range, Rng2 As Range) As Boolean
Dim rCtr As Long
Dim cCtr As Long
ThereIsADifference = False
For rCtr = 1 To Rng1.Rows.Count
For cCtr = 1 To Rng2.Rows.Count
If Rng1(rCtr, cCtr).Value = Rng2(rCtr, cCtr).Value Then
'matches so far
Else
ThereIsADifference = True
Exit For
End If
Next cCtr
Next rCtr
End Function

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
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

ya my range is fixed: A11 to D20 and that's it...

If it ever changes, is because an employee left or was added, in which
case I will edit the range : - )

what do you think ?

all I changed was the reference to the sheet, and location to the file
where it's saves the master and

For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("A11:D20")
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

dave,

should the False be true ? and true be false ?

Function ThereIsADifference(Rng1 As Range, Rng2 As Range) As Boolean
Dim rCtr As Long
Dim cCtr As Long
ThereIsADifference = True
For rCtr = 1 To Rng1.Rows.Count
For cCtr = 1 To Rng2.Rows.Count
If Rng1(rCtr, cCtr).Value = Rng2(rCtr, cCtr).Value Then
'matches so far
Else
ThereIsADifference = False
Exit For
End If
Next cCtr
Next rCtr
End Function

when I switched it, now it doesn't cope a duplicate it seems, but if I
change the dates in column B, even if the rest is the same, A C and D
it should treat it as the same and it does....

ok, last message and then I go off to lunch :- )

Basically

I have 4 columns

A holds static values for the department
B holds =today() date
C holds employee names, also static unless I add or remove some...
D holds the drop down list HR codes, here, absent, vacation, u know, so
on...

Anyways to make it compare also B and C ? as well as the Range like it
is now ?

Yep. I messed around with it enough to get me confused!

RompStar wrote:
>
> dave,
>
> should the False be true ? and true be false ?
>
> Function ThereIsADifference(Rng1 As Range, Rng2 As Range) As Boolean
> Dim rCtr As Long
> Dim cCtr As Long
> ThereIsADifference = True
> For rCtr = 1 To Rng1.Rows.Count
> For cCtr = 1 To Rng2.Rows.Count
> If Rng1(rCtr, cCtr).Value = Rng2(rCtr, cCtr).Value Then
> 'matches so far
> Else
> ThereIsADifference = False
> Exit For
> End If
> Next cCtr
> Next rCtr
> End Function
>
> when I switched it, now it doesn't cope a duplicate it seems, but if I
> change the dates in column B, even if the rest is the same, A C and D
> it should treat it as the same and it does....

--

Dave Peterson

This portion:

With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("d11:E" _
& .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
End With

Defines the columns to get copied and where to paste the topleftcell of the
copied range.

If you want A:E, you could change it to:

With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("A11:E" _
& .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With


I used column A to find the last used row for the copy and to find the next
available row for the paste.

Don't forget to change to pastespecial values if that's what you need.



RompStar wrote:
>
> ok, last message and then I go off to lunch :- )
>
> Basically
>
> I have 4 columns
>
> A holds static values for the department
> B holds =today() date
> C holds employee names, also static unless I add or remove some...
> D holds the drop down list HR codes, here, absent, vacation, u know, so
> on...
>
> Anyways to make it compare also B and C ? as well as the Range like it
> is now ?

--

Dave Peterson

I have comments below row 20, not data, just HOWTO comments to the
user, so shouldn't that be a11:d20 ? since I want only the rows with
the data ?

With CurWkbk.Worksheets(SheetNames(=ADsCtr))
Set RngToCopy =3D .Range("A11:D20" _
& .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames=AD(sCtr))
Set DestCell =3D .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

dude

how do you do that compare with tow cells ?

I want to compare two cells E1 and B11 with dates, if they are the same
go to end of script...

so far I have this:

Sub SaveMe()
Dim test1 As Range, test2 As Range
Set test1 = Worksheets("Robert").Range("E1")
Set test2 = Worksheets("Robert").Range("B11")

If test1.Value = test2.Value Then
GoTo exitEnd:
Else
SaveMe2
End If

exitEnd:
' Application.ScreenUpdating = True
MsgBox "Can't update, duplicate records detected, can't upload the same
info. twice."

End Sub

So if the dates match, show a msgbox and end.. if they don't match go
on to sub SaveMe2, but I just need to compare two cell values, not the
whole range, can you help ?

I think for now this will be the easiest way..

I didn't understand the static range vs the code you pasted.

It's even simpler:

With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("A11:D20")
.....

all that .cells(.rows.count,"A").end(xlup).row did was this (manually):

start at A65536
hit End key
hit uparrow

But since the range is static, you don't have to jump through hoops.


RompStar wrote:
>
> I have comments below row 20, not data, just HOWTO comments to the
> user, so shouldn't that be a11:d20 ? since I want only the rows with
> the data ?
>
> With CurWkbk.Worksheets(SheetNames(*sCtr))
> Set RngToCopy = .Range("A11:D20" _
> & .Cells(.Rows.Count, "A").End(xlUp).Row)
> End With
> With MstrWkbk.Worksheets(SheetNames*(sCtr))
> Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
> End With

--

Dave Peterson

ya, my boss doesn't want that, he thinks the users are stupid, and even
if the message box was there, they would still press it :- )

So I need somekind of a caompare feature, and until I learn more
complicated things, that E1 to B11 to compare the dates should do
for now and keep the boss happy until later :- )

I wanted to do this:

that code doesn't seem to compare the date right, even if B11 and E1
have the same date, it still goes on..

the code must be wrong..

anyways, long day I go home.

You're dropping my suggestion, huh???

Sub SaveMe()
Dim test1 As Range, test2 As Range
Set test1 = Worksheets("Robert").Range("E1")
Set test2 = Worksheets("Robert").Range("B11")

If test1.Value = test2.Value Then
msgbox "can't update..."
goto exitnow:
Else
SaveMe2
End If

'rest of code here

exitNow:
'more rest of code

End Sub

If you were using the original post.

But your code would have worked ok--except that you'd always get that msgbox at
the end:

Sub SaveMe()
Dim test1 As Range, test2 As Range
Set test1 = Worksheets("Robert").Range("E1")
Set test2 = Worksheets("Robert").Range("B11")

If test1.Value = test2.Value Then
GoTo exitEnd:
Else
SaveMe2
End If

Exit sub 'get out now, avoid that last msgbox.

exitEnd:
' Application.ScreenUpdating = True
MsgBox "Can't update, duplicate records detected, can't upload the same
info. twice."

End Sub

RompStar wrote:
>
> dude
>
> how do you do that compare with tow cells ?
>
> I want to compare two cells E1 and B11 with dates, if they are the same
> go to end of script...
>
> so far I have this:
>
> Sub SaveMe()
> Dim test1 As Range, test2 As Range
> Set test1 = Worksheets("Robert").Range("E1")
> Set test2 = Worksheets("Robert").Range("B11")
>
> If test1.Value = test2.Value Then
> GoTo exitEnd:
> Else
> SaveMe2
> End If
>
> exitEnd:
> ' Application.ScreenUpdating = True
> MsgBox "Can't update, duplicate records detected, can't upload the same
> info. twice."
>
> End Sub
>
> So if the dates match, show a msgbox and end.. if they don't match go
> on to sub SaveMe2, but I just need to compare two cell values, not the
> whole range, can you help ?
>
> I think for now this will be the easiest way..

--

Dave Peterson

It looked like you were dropping the comparison of the ranges (Cell by cell) and
using the date comparison instead.

try this version:

If test1.Value2 = test2.Value2 Then

If you put:
msgbox test1.value & vblf & test2.value
can you see any difference?

Are they both dates (or is one text just masquerading as a date)?

Are both workbooks using the same base date?
tools|options|Calculation tab|1904 Date System

Did you include the time in either cell?


RompStar wrote:
>
> ya, my boss doesn't want that, he thinks the users are stupid, and even
> if the message box was there, they would still press it :- )
>
> So I need somekind of a caompare feature, and until I learn more
> complicated things, that E1 to B11 to compare the dates should do
> for now and keep the boss happy until later :- )
>
> I wanted to do this:
>
> that code doesn't seem to compare the date right, even if B11 and E1
> have the same date, it still goes on..
>
> the code must be wrong..
>
> anyways, long day I go home.

--

Dave Peterson

RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues = -4163

this correct ?

how come it moves over the validation list ? and the =today() ???

question:

is this possible to be added or made ?

The data is uploaded over the network to the append file, what if the
network is down, or like extra slow

if something takes too long, like over 60 seconds, or maybe 2 minutes,
it would pops up
a bob saying, network busy, please try again, data wasn't uploaded...

or something like that, what does the 1904 date system is ? how does
that differ if that is check or not ?

this one seems to work now right, but it still move the list formats
and =today() which I don't want into the append file...

what do you think about this:

RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats = 12

this works,, damn I am happy, I can acctually spot mistakes and fix it,
I might not be a season pro, but
I know things that didn't before, thanks to people like you..

:-)

dude, question, I looked into the upload Master file where the date
goes into, and the Column B that holds dates is different then column
B in the append file..

I have in the daily for date =today() which is 5/13/2005 but in the
append it inserts 5/12/2001, how is that happending ?

Take a look in VBA's help. You'll find that .value2 brings back the underlying
value of dates and currency (as doubles):

Option Explicit
Sub testme()
With Range("a1")
.Value = Now
Debug.Print "Value: " & .Value
Debug.Print "Value2: " & .Value2
End With
End Sub

returned:
Value: 05/13/2005 10:23:15
Value2: 38485.4328125



RompStar wrote:
>
> so I am happy and the boss is happy, no budget to hire anyone, so I
> guess I don't mind learning it and getting paid to :- )
>
> always wanted to learn something well..
>
> btw: what's the difference between Value and Value2
>
> If test1.Value = test2.Value Then
> If test1.Value2 = test2.Value2 Then

--

Dave Peterson

so I am happy and the boss is happy, no budget to hire anyone, so I
guess I don't mind learning it and getting paid to :- )

always wanted to learn something well..

btw: what's the difference between Value and Value2

If test1.Value = test2.Value Then
If test1.Value2 = test2.Value2 Then

here is how it looks now:

Option Explicit

Sub SaveMe()
Dim test1 As Range, test2 As Range
Set test1 = Worksheets("Robert").Range("E1")
Set test2 = Worksheets("Robert").Range("B11")

If test1.Value2 = test2.Value2 Then
MsgBox "You can only update the database once a day!!! If you made a
mistake, message: RompStar"
'MsgBox test1.Value & vbLf & test2.Value
Exit Sub
Else

Call SaveMe2
End If

'rest of code here
' Exit Sub
End Sub

Sub SaveMe2()

Dim MstrWkbk As Workbook
Dim MstrWkbkName As String
Dim CurWkbk As Workbook
Dim SheetNames As Variant
Dim sCtr As Long
Dim testStr As String
Dim okToContinue As Boolean
Dim RngToCopy As Range
Dim DestCell As Range
Dim resp As Long

' Enter file location name, needs to match or else the Cat gets it.

MstrWkbkName = "\\network\location\appendfile.xls"
testStr = ""
On Error Resume Next
testStr = Dir(MstrWkbkName)
On Error GoTo 0

If testStr = "" Then
MsgBox "Master workbook not found! Contact: [email protected]"
GoTo exitNow:
End If

' Pop a BOX on the screen to warn of double-appends

resp = MsgBox(Prompt:="Please make sure the data is correct before
uploading... Are you sure you want to run this?", _
Buttons:=vbYesNo)

' If user chooses No, then exit script...

If resp = vbNo Then
GoTo exitEnd:
End If

' The sheet name better match or else...

SheetNames = Array("Robert")

Application.ScreenUpdating = False

Set CurWkbk = ActiveWorkbook
Set MstrWkbk = Workbooks.Open(Filename:=MstrWkbkName)
okToContinue = True

For sCtr = LBound(SheetNames) To UBound(SheetNames)

' Current Daily Workbook reference/error check

If WorksheetExists(SheetNames(sCtr), CurWkbk) = False Then
MsgBox CurWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If

' Master append Workbook reference/error check

If WorksheetExists(SheetNames(sCtr), MstrWkbk) = False Then
MsgBox MstrWkbk.Name & " doesn't have a sheet named: " _
& SheetNames(sCtr)
okToContinue = False
End If

Next sCtr

If okToContinue = False Then
MstrWkbk.Close savechanges:=False
MsgBox "Please fix those worksheet names!"
GoTo exitNow:
End If

For sCtr = LBound(SheetNames) To UBound(SheetNames)
With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("a11:d20")
' & .Cells(.Rows.Count, "D").End(xlUp).Row)
End With
With MstrWkbk.Worksheets(SheetNames(sCtr))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues

'RngToCopy.Copy _
'Destination:=DestCell
Next sCtr

MstrWkbk.Close savechanges:=True

exitNow:
Application.ScreenUpdating = True
MsgBox "Data was uploaded to the Master Append File, please close the
application. When closing Excel will ask you if you want to save to the
local drive, select NO! Always open the template link from the network
drive, thanks - Ray."

' Insert today's date into cell E1 for duplicate comparison
Range("E1").Value = Date

exitEnd:

End Sub

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
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

just the date?

range("e1").value = date

should be ok.

RompStar wrote:
>
> both of the cells E1 and B11 are formatted for date
>
> E1 had 5/12/2005 2:55:17 PM
> B11 =TODAY()
>
> what do you think ?
>
> I took the time out in E1, let me check that...
>
> What's the best code also use to insert the date stamp into E1 at the
> end of the VB running script ? that uploads ?
>
> I have: Range("E1") = Now
>
> should I have something else ?

--

Dave Peterson

=today() will evaluate to 5/12/2005 (exactly).

So your kind of comparing: 2 to 2.5 and expecting them to be the same.

If format(test1.Value, "yyyymmdd") = format(test2.Value,"yyyymmdd") Then
or
If int(test1.Value2) = int(test2.Value2) Then

should work.

RompStar wrote:
>
> both of the cells E1 and B11 are formatted for date
>
> E1 had 5/12/2005 2:55:17 PM
> B11 =TODAY()
>
> what do you think ?
>
> I took the time out in E1, let me check that...
>
> What's the best code also use to insert the date stamp into E1 at the
> end of the VB running script ? that uploads ?
>
> I have: Range("E1") = Now
>
> should I have something else ?

--

Dave Peterson

both of the cells E1 and B11 are formatted for date

E1 had 5/12/2005 2:55:17 PM
B11 =TODAY()

what do you think ?

I took the time out in E1, let me check that...

What's the best code also use to insert the date stamp into E1 at the
end of the VB running script ? that uploads ?

I have: Range("E1") = Now

should I have something else ?

Catching up...

I don't know of a way to test the timing of the network.

Most Mac users use a base date of 1904. Most windows users use 1900. If it
were my project, I'd change all my workbooks to use the same base date (and I as
a wintel user would choose 1900).

Saved from a previous post:

One workbook was using a base year of 1900 and the other was using 1904.
(tools|options|calculation tab|1904 date system)

One way to add those four years back is to find an empty cell, put 1462 into
that cell.

Copy that cell.

Select your range that contains the dates. Edit|PasteSpecial|click Add (in the
operation box).

You may have to reformat the cell as a date (mine turned to a 5 digit number).
But it should work.

You may want to do it against a copy...just in case.

(I'm not sure which one you'll fix. You may want to edit|pastespecial|click
subtract.)

Most windows users use 1900 as the base date. Mac users (mostly??) use 1904 as
the base date.

====
In code, you could do something like:
Option Explicit
Sub testme01()

Dim wkbk1 As Workbook
Dim wkbk2 As Workbook
Dim myAdjustment As Long

'copying from wkbk2 into wkbk1
Set wkbk1 = Workbooks("book1")
Set wkbk2 = Workbooks("book2")

If wkbk1.Date1904 = wkbk2.Date1904 Then
myAdjustment = 0
Else
If wkbk1.Date1904 = True Then
myAdjustment = 1462
Else
myAdjustment = -1462
End If
End If

wkbk1.Worksheets(1).Range("a1").Copy _
Destination:=wkbk2.Worksheets(1).Range("a1")

With wkbk2.Worksheets(1).Range("a1")
.Value = .Value + myAdjustment
End With

End Sub

(But I'd just change the setting and adjust the dates manually!)

=======

And get rid of those numbers like "= -4163" in these lines:
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues = -4163

Just use:
RngToCopy.Copy
DestCell.PasteSpecial Paste:=xlPasteValues

By adding the extra stuff, you're doing:

RngToCopy.Copy
DestCell.PasteSpecial Paste:=clng(cbool(xlPasteValues = -4163))

xlpastevalues is a constant that represents -4163.

So this:
Paste:=clng(cbool(xlPasteValues = -4163))
which looks like:
Paste:=clng(cbool(-4163 = -4163))
which looks like:
Paste:=clng(cbool(true))
which looks like:
paste:=clng(True)
which looks like:
paste:=-1

Which isn't what you want for that parm!




RompStar wrote:
>
> RngToCopy.Copy
> DestCell.PasteSpecial Paste:=xlPasteValues = -4163
>
> this correct ?
>
> how come it moves over the validation list ? and the =today() ???

--

Dave Peterson

wow, so many things I am learning, ya manual seems great...

what about something like this:

Ok, in column B I have a validation drop-list, with many options...

When the document template is opened everyday by someone filling it
out, I would like to have the validation list for my range B11:B20 to
default to the first list option from the list... because after the
file is uploaded, I want them to save that template because the E1 date
needs to be stored, but when they reopen it the next day, I don't want
them to have to default to the first option in the list by hand,
because some departments have a lot of employees and it wastes time, so
if they reopen the template the next day, I want the E1 value stored
when they close the application to the template, but also when they
reopen it the next day for the list to default to the first option in
the list.

What do you think ?


any ideas ?

I'm not quite sure what you mean, but you could add something in the auto_open
(or workbook_open) procedure to make that cell whatever you want.

with worksheets("sheet1").range("e1")
.value = "type the value you want here"
'or
.clearcontents 'to reset to empty
end with



RompStar wrote:
>
> wow, so many things I am learning, ya manual seems great...
>
> what about something like this:
>
> Ok, in column B I have a validation drop-list, with many options...
>
> When the document template is opened everyday by someone filling it
> out, I would like to have the validation list for my range B11:B20 to
> default to the first list option from the list... because after the
> file is uploaded, I want them to save that template because the E1 date
> needs to be stored, but when they reopen it the next day, I don't want
> them to have to default to the first option in the list by hand,
> because some departments have a lot of employees and it wastes time, so
> if they reopen the template the next day, I want the E1 value stored
> when they close the application to the template, but also when they
> reopen it the next day for the list to default to the first option in
> the list.
>
> What do you think ?
>
> any ideas ?

--

Dave Peterson

thanks for all your help, prbably going to need it in the future :- )

lol

thanks again.

Glad everything is working.

See you in your next thread <bg>.

RompStar wrote:
>
> thanks for all your help, prbably going to need it in the future :- )
>
> lol
>
> thanks again.

--

Dave Peterson

haha, I think I need your help again, also new things to learn ;- )

ok, this script looks in the active sheet and takes the emails out of
column M and generates emails, right now it's grabbing the header
files, but I want a simple static template to be put into the body of
the message, so I think the last part needs to be changed, the Function
RangetoHTML2()..

All I want is a simple template to start off in the body of the
message, like

start body ---

Hello,

blalblalalalalalalalalblblblalblblblalbaslablbalal blablab la
dasdasdasdasdasdasdasdasdasdasdasdasd.


Have a greate blablabla...

Signature...

end body --------


--------------- how the script looks now....

Option Explicit

Dim Nsh As Worksheet

Sub Send_Row()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range
Dim rng As Range
Dim Ash As Worksheet

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set Ash = ActiveSheet
Set Nsh = Worksheets.Add
Ash.Activate

On Error GoTo cleanup
For Each cell In
Ash.Columns("M").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
Ash.Range("A1:O100").AutoFilter Field:=2,
Criteria1:=cell.Value
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
rng.Copy Nsh.Cells(1)
Nsh.Columns.AutoFit
Ash.AutoFilterMode = False

Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "PC Recycle pickup request"
.HTMLBody = RangetoHTML2
.Display 'Or use Display for testing. .Send for real
End With
Set OutMail = Nothing
Nsh.Cells.Clear
End If
Next cell

cleanup:
Application.DisplayAlerts = False
Nsh.Delete
Application.DisplayAlerts = True
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Function RangetoHTML2()
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=Nsh.Name, _
Source:=Nsh.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function

I understand most of this code, but not everything, any idea how to
change this ? considering that I want a simple template for the BODY,
just text ?

Also I noticed that if there were 20 rows, with the email address being
in column M of each row, it generates, a new email message for each
one, I would prefer to have it all in a single email and just space the
aliases

email; email2; email3

any ideas ?

You may want to post in a new thread. I don't use Outlook and don't think I
could help.

RompStar wrote:
>
> haha, I think I need your help again, also new things to learn ;- )
>
> ok, this script looks in the active sheet and takes the emails out of
> column M and generates emails, right now it's grabbing the header
> files, but I want a simple static template to be put into the body of
> the message, so I think the last part needs to be changed, the Function
> RangetoHTML2()..
>
> All I want is a simple template to start off in the body of the
> message, like
>
> start body ---
>
> Hello,
>
> blalblalalalalalalalalblblblalblblblalbaslablbalal blablab la
> dasdasdasdasdasdasdasdasdasdasdasdasd.
>
> Have a greate blablabla...
>
> Signature...
>
> end body --------
>
> --------------- how the script looks now....
>
> Option Explicit
>
> Dim Nsh As Worksheet
>
> Sub Send_Row()
> Dim OutApp As Outlook.Application
> Dim OutMail As Outlook.MailItem
> Dim cell As Range
> Dim rng As Range
> Dim Ash As Worksheet
>
> Application.ScreenUpdating = False
> Set OutApp = CreateObject("Outlook.Application")
> Set Ash = ActiveSheet
> Set Nsh = Worksheets.Add
> Ash.Activate
>
> On Error GoTo cleanup
> For Each cell In
> Ash.Columns("M").Cells.SpecialCells(xlCellTypeConstants)
> If cell.Value Like "?*@?*.?*" Then
> Ash.Range("A1:O100").AutoFilter Field:=2,
> Criteria1:=cell.Value
> With Ash.AutoFilter.Range
> On Error Resume Next
> Set rng = .SpecialCells(xlCellTypeVisible)
> On Error GoTo 0
> End With
> rng.Copy Nsh.Cells(1)
> Nsh.Columns.AutoFit
> Ash.AutoFilterMode = False
>
> Set OutMail = OutApp.CreateItem(olMailItem)
> With OutMail
> .To = cell.Value
> .Subject = "PC Recycle pickup request"
> .HTMLBody = RangetoHTML2
> .Display 'Or use Display for testing. .Send for real
> End With
> Set OutMail = Nothing
> Nsh.Cells.Clear
> End If
> Next cell
>
> cleanup:
> Application.DisplayAlerts = False
> Nsh.Delete
> Application.DisplayAlerts = True
> Set OutApp = Nothing
> Application.ScreenUpdating = True
> End Sub
>
> Function RangetoHTML2()
> Dim fso As Object
> Dim ts As Object
> Dim TempFile As String
> TempFile = Environ$("temp") & "/" & _
> Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
> With ActiveWorkbook.PublishObjects.Add( _
> SourceType:=xlSourceRange, _
> Filename:=TempFile, _
> Sheet:=Nsh.Name, _
> Source:=Nsh.UsedRange.Address, _
> HtmlType:=xlHtmlStatic)
> .Publish (True)
> End With
> Set fso = CreateObject("Scripting.FileSystemObject")
> Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
> RangetoHTML2 = ts.ReadAll
> ts.Close
> Set ts = Nothing
> Set fso = Nothing
> Kill TempFile
> End Function
>
> I understand most of this code, but not everything, any idea how to
> change this ? considering that I want a simple template for the BODY,
> just text ?
>
> Also I noticed that if there were 20 rows, with the email address being
> in column M of each row, it generates, a new email message for each
> one, I would prefer to have it all in a single email and just space the
> aliases
>
> email; email2; email3
>
> any ideas ?

--

Dave Peterson

Is ok :- )

I bought this cool book called Excel VBA Programming for Dummies, wow,
great way of explaining things, I was reading this other book and it
wasn't explain things well at all, but now that I read this book,
everything is starting to make sense, I love the For Dummies Series as
the first step.

Debra Dalgleish has a list of books at:
http://www.contextures.com/xlbooks.html

You may want to print a copy and take it with you when you visit your local
bookstore/library.

RompStar wrote:
>
> Is ok :- )
>
> I bought this cool book called Excel VBA Programming for Dummies, wow,
> great way of explaining things, I was reading this other book and it
> wasn't explain things well at all, but now that I read this book,
> everything is starting to make sense, I love the For Dummies Series as
> the first step.

--

Dave Peterson