Workbook_SheetCalculate

[stevebutler]

Is there a way to make this sub routine run every second calculation?

I have a code that prompts the user under certain conditions. but since the sheet makes 2 calculations at a time, it gives the same prompt twice. any ideas?

thanks
steve

 

[Greg Truby]

...How did you guys learn all of this?

Well, reading one of Walkenbach's books (or Bill's :wink helps a lot. Then, in the VBE... the F1 key, or the F2 key and then the F1 key Look through the object browser until I can't remember what I've seen. Try everything I can think of. Then Search here and read, read, read. Then google search and read some more. Then if I was still stumped, I would post my question and hope juan pablo, tom u., nate, damon or any of the other many, many good coders that frequent this site see my thread and could help.

 

[stevebutler]

thanks man...

one more question

i have a template that the user enters a project name, then has to SaveAs

is it possible to take the project name (value of "KeyCell"), and copy it into another workbook. in other words, keep a running tab of all the jobs that are created. i guess it's like a mini database. thanks in advance

 

[Greg Truby]

More'n likely. Sounds like all's you'd need do would be to add code to the _BeforeSave event handler in the template's workbook code module that opens your tracking workbook, appends what you want and then saves & closes the tracker. You can use the SaveAsUI arg in the _BeforeSave handler to test whether the user is doing a SaveAs or a normal Save and ignore standard Saves if you want to.

Give 'er a shot and if you get so stuck you can't figure it out, post back.

 

[stevebutler]

can i reference this tracker without opening, saving, then closing again?

 

[Greg Truby]

AFAIK, you can only "passively" reference it without opening saving and closing, i.e. you can have formulas pull information out. But if you want to alter the contents of the tracker workbook and have those changes stick, I'm pretty sure you're gonna have to open it and save it, somehow.

Having said that, there's nothing that says that you've gotta update the tracking workbook synchronously with the saving of the template(s). You could have your template's _BeforeSave method toss some naming-protocol-following TXT or CSV file out somewhere (network drive) and then when you open your tracker, it scans the collection directory for files that follow the naming protocol, opens them, imports their data and kills them.

 

[stevebutler]

interesting....but i think i'm going to stick with the before_save event. just in case the tracker isn't updated for a while, and some files may be moved to different directories. i'll post the code i come up with...

 

[stevebutler]

greg,

here is what i came up with so far, i got some help from the internet.

it's crude, but i'm on the right path. what i need to do now is check if this job name is already on the list, and if it is, to not copy it again.

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function



Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("database.xls") Then
Set destWB = Workbooks("database.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and Settings\steve\Desktop" & "\" & "database")
End If
Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub

 

[Greg Truby]

Where would the job name be located?

 

[stevebutler]

The job name is entered into a cell, say A1, of ThisWorkbook. Then it is copied onto "database".

 

[Greg Truby]

...say A1...

Alrighty, using A1 as the value to scan for -- based on your code your source is getting copied into columns A:C of your log. So we'd need to scan column A for the job number. You want one line of code using FIND and add one label (CleanUp) to help exit gracefully.

Sub copy_to_another_workbook()
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
    Dim sourceRange As Range
    Dim destrange As Range
    Dim destWB As Workbook
    Dim Lr As Long
    
    Application.ScreenUpdating = False
    If bIsBookOpen("database.xls") Then
        Set destWB = Workbooks("database.xls")
    Else
        Set destWB = Workbooks.Open("C:\Documents and Settings\steve\Desktop" & "\" & "database")
    End If
    
    Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
    
    Set sourceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:C10")
    ' look for job name in existing list, exit if found
    If Not destWB.Worksheets("Sheet1").Range("A1:A" & Lr - 1).Find(What:=sourceRange.Cells(1, 1), LookAt:=xlWhole) Is Nothing Then GoTo CleanUp
    Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
    sourceRange.Copy
    destrange.PasteSpecial xlPasteValues, , False, False
    Application.CutCopyMode = False
    
CleanUp:
    destWB.Close True
    Application.ScreenUpdating = True
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
    ' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function