Update on Any Changes

[fad1959]

Can i save a Worksheet or Workbook,

Only when there are changes made in say Cells C3:D30 on a shared Workbook


The problem:

Shared workbook doesn't seem to update when other users make changes.

will it work instantaneously with any changes in mentioned cells

I've been to Tools>Share Work book menu

Thank you
Frank

 

[Smitty]

I don't think that this will be real user firendly if your wb is substantially sized due to the amount of time taken when saving, but it will save the wb whenever a change is made in C3:D30:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)
    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range
     <SPAN style="color:#007F00">'   Only look at single cell changes</SPAN>
    <SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rng = Range("C3:D30")
    <SPAN style="color:#007F00">'   Only look at that range</SPAN>
    <SPAN style="color:#00007F">If</SPAN> Intersect(Target, rng) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
        ActiveWorkbook.Save
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Note that you'll need to unshare the wb to get the code in as VB projects aren't available in shareed mode.

As for why changes aren't being reflected, could it be that users aren't saving?

You could also force saving with:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_BeforeClose(Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)
    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>
        ActiveWorkbook.Save
    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

If you've got questions on what to do with the code, post back.

Hope that helps,

Smitty

 

[fad1959]

Thanks Smitty,

I used this code in thisworkbook and it seems to work pretty good but it

would work better if it can update every minute i think


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub

 

[Norie]

Does this work?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strNow As String
Dim rowTgt As Long
Dim valTgt
Dim ws As Worksheet
Dim rngC As Range
Dim rngD As Range
Dim SaveFlag As Boolean

    If Target.Column <> 2 Then
        Exit Sub
    End If
    
    If Target.Row < 3 Or Target.Row > 30 Then
        Exit Sub
    End If

    SaveFlag = True
    strNow = Format(Now(), "hh:mm:ss AMPM")

    rowTgt = Target.Row
    
    Set ws = Sheets("Sheet1")
    Set rngC = ws.Range("C" & rowTgt)
    Set rngD = ws.Range("D" & rowTgt)
    
    valTgt = Target.Value
    
    Select Case valTgt
    
        Case "IN OFFICE"
            rngD = strNow
            rngC = ""
        Case "Depart Lunch/Road Sup", "Out Of Office"
            rngC = strNow
        Case "Return Lunch/Road Sup", "Return From Meeting", "Return From Lunch"
            rngD = strNow
        Case "Out For Lunch"
            rngC = strNow
            rngD = ""
        Case Else
            rngC = ""
            rngD = ""
            SaveFlag = False
            
    End Select
    
    If SaveFlag Then
        Application.DisplayAlerts = False
        ActiveWorkbook.Save
        Application.DisplayAlerts = True
    End If
End Sub