how to save ranges into a running file...

[Dave Peterson]

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

 

[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]

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("A1120" _
& .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

 

[RompStar]

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]

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

It's even simpler:

With CurWkbk.Worksheets(SheetNames(sCtr))
Set RngToCopy = .Range("A1120")
.....

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.

 

[Dave Peterson]

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]

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]

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]

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.

 

[Dave Peterson]

just the date?

range("e1").value = date

should be ok.

 

[RompStar]

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: (e-mail address removed)"
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

 

[RompStar]

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]

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]

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 ?

 

[RompStar]

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..

 

[RompStar]

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...

 

[RompStar]

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

this correct ?

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

 

[RompStar]

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 ?

 

[Dave Peterson]

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!