excel file won't save when vba calls activeworkbook.refresh or save

[Alfordm]

Hi,
Can someone assit me by looking over my code below or alternativly at my workbook & make any suggestions as to why it won't execute when the file is shared?
This is my first attempt at VBA & I'm stumped!
It is part of a 'Scan in / Out' time capture workbook that I've written up.
Reason is that I need to share the work book & I can't seem to get the ___.RefreshAll to work.
My intention is to Refresh the current instance of the workbook just before information is written to a range so as to ensure it is written to an empty cell when multiple users are running the workbook.
The code is called from the 'Scan In / Out' button on my sheet. Link to workbook location is https://www.cubby.com/pl/Excel+help/_caf1f45734b54ccd8d3688322d6ef828
& the code in question is below.
I'm using 2010 but may need to run it on some older 2003 units.
Many thanks in advance.
Mat in Australia.

[Private Sub ScanInOut_Click()
    Dim found As Boolean
    Dim dtmNow As Date
    Dim strName As String
    Dim strCode As String
    Dim Counter As Integer
    Dim Check As Boolean
   ' Me.Hide
    
    
        strCode = InputBox(Prompt:="Please Enter Your Pass Code.", _
              Title:="ENTER YOUR CODE", Default:="Your Pass Code Here")
              
        If strCode = "Your Pass Code Here" Or strCode = vbNullString Then
        'MsgBox ("Error, default values were not updated in the 'Name' boxes")
        CreateObject("Wscript.Shell").Popup "Error, Please try again", 2, "Auto-Close", 0
        End If
        'Exit Sub
           
            
            'strCode = StrConv(strCode, vbLowerCase)
            Counter = 0
            Check = False
            Do Until found = True
            Counter = Counter + 1
        
        
            
        If Sheets("Admin sheet").Range("R1").Offset(Counter, 3) = strCode Then
            found = True
           End If
                    
            If Sheets("Admin sheet").Range("R1").Offset(Counter, 3) = "" Then
                CreateObject("Wscript.Shell").Popup "Name is not in list. Please see Admin.", 2, "Auto-Close", 0
                'Unload Me
                Exit Sub
                End If
                Loop
                
            If Sheets("Admin Sheet").Range("R1").Offset(Counter, 3) = strCode Then
                Counter = 0
                found = False
                Do Until found = True
                If Sheets("Admin Sheet").Range("O13") = "Yes" Then
                    dtmNow = Sheets("Admin Sheet").Range("O15")
                    Else
                        dtmNow = Now
                End If
                
                    If Sheets("Admin Sheet").Range("A1").Offset(Counter, 0) = strCode And Sheets("Admin Sheet").Range("A1").Offset(Counter, 6) = "" Then
                            Sheets("Admin Sheet").Range("A1").Offset(Counter, 6) = "@"
                            Sheets("Admin Sheet").Range("A1").Offset(Counter, 6) = dtmNow
                            found = True
                            CreateObject("Wscript.Shell").Popup "Punched out", 1, "Auto-Close", 0
                            'ActiveWorkbook.RefreshAll
                            'ActiveWorkbook.Save
                            'Unload Me
                    Else
                            
                    If Sheets("Admin Sheet").Range("A1").Offset(Counter, 0) = "" Then
                        Sheets("Admin Sheet").Range("A1").Offset(Counter, 0).NumberFormat = "@"
                        Sheets("Admin Sheet").Range("A1").Offset(Counter, 0) = strCode
                        Sheets("Admin Sheet").Range("A1").Offset(Counter, 5) = dtmNow
                        found = True
                            CreateObject("Wscript.Shell").Popup "Punched in", 1, "Auto-Close", 0
                            'ActiveWorkbook.RefreshAll
                            'ActiveWorkbook.Save
                            
                End If
        End If
        Counter = Counter + 1
        Loop
    End If
    ActiveWorkbook.Save
    ActiveWorkbook.RefreshAll
    'Call macro1
    Call ScanInOut_Click
End Sub
/CODE]

 

[sijpie]

I can't test multiuser easily.

But i noticed some inefficient code in your code: rather than looping through each row, just use range.Find:

 

[sijpie]

sorry the code:
<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> ScanInOut_Click()<br>    <SPAN style="color:#00007F">Dim</SPAN> found <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> dtmNow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Date</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> strName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> strCode <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> Counter <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> Check <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> rFnd <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#007F00">' Me.Hide</SPAN><br>    <br>    <br>    strCode = InputBox(Prompt:="Please Enter Your Pass Code.", _<br>    Title:="ENTER YOUR CODE", Default:="Your Pass Code Here")<br>    <br>    <SPAN style="color:#00007F">If</SPAN> strCode = "Your Pass Code Here" <SPAN style="color:#00007F">Or</SPAN> strCode = vbNullString <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#007F00">'MsgBox ("Error, default values were not updated in the 'Name' boxes")</SPAN><br>        CreateObject("Wscript.Shell").Popup "Error, Please try again", 2, "Auto-Close", 0<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#007F00">'Exit Sub</SPAN><br>    <br>    <br>    <SPAN style="color:#007F00">'strCode = StrConv(strCode, vbLowerCase)</SPAN><br>    Counter = 0<br>    Check = <SPAN style="color:#00007F">False</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> rFnd = Sheets("Admin sheet").Columns("R").Find(what:=strCode, LookIn:=xlValue, lookat:=xlWhole)<br>    <SPAN style="color:#00007F">If</SPAN> rFnd <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>  <SPAN style="color:#007F00">' strCode not found</SPAN><br>    <br>        CreateObject("Wscript.Shell").Popup "Name is not in list. Please see Admin.", 2, "Auto-Close", 0<br>        <SPAN style="color:#007F00">'Unload Me</SPAN><br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Sheets("Admin Sheet").Range("O13") = "Yes" <SPAN style="color:#00007F">Then</SPAN><br>        dtmNow = Sheets("Admin Sheet").Range("O15")<br>    <SPAN style="color:#00007F">Else</SPAN><br>        dtmNow = Now<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><br>    <SPAN style="color:#007F00">' find last occurance of strCode in the table</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rFnd = Sheets("Admin sheet").Columns("A").Find(what:=strCode, after:=[a1], _<br>            LookIn:=xlValue, lookat:=xlWhole, SearchDirection:=xlPrevious)<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> rFnd <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>  <SPAN style="color:#007F00">' strCode  found</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> rFnd.Offset(0, 6) <> "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">' need to punch out</SPAN><br>            rFnd.Offset(0, 6).NumberFormat = "@"<br>            rFnd.Offset(0, 6) = dtmNow<br>            CreateObject("Wscript.Shell").Popup "Punched out", 1, "Auto-Close", 0<br>            <SPAN style="color:#007F00">'ActiveWorkbook.RefreshAll</SPAN><br>            <SPAN style="color:#007F00">'ActiveWorkbook.Save</SPAN><br>            <SPAN style="color:#007F00">'Unload Me</SPAN><br>        <SPAN style="color:#00007F">Else</SPAN>    <SPAN style="color:#007F00">' punch in</SPAN><br>            <SPAN style="color:#00007F">GoTo</SPAN> PunchIn<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Else</SPAN>    <SPAN style="color:#007F00">' Code not found, punch in:</SPAN><br>PunchIn:<br>        <SPAN style="color:#007F00">' find last entry is sheet</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> rFnd = Sheets("Admin sheet").Columns("A").Find(what:="*", after:=[a1], _<br>             SearchDirection:=xlPrevious)<br>             <br>        rFnd.Offset(1, 0).NumberFormat = "@"<br>        rFnd.Offset(1, 0) = strCode<br>        rFnd.Offset(1, 5) = dtmNow<br>        CreateObject("Wscript.Shell").Popup "Punched in", 1, "Auto-Close", 0<br>        <SPAN style="color:#007F00">'ActiveWorkbook.RefreshAll</SPAN><br>        <SPAN style="color:#007F00">'ActiveWorkbook.Save</SPAN><br>    <br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>   <br>    <br>    ActiveWorkbook.Save<br>    ActiveWorkbook.RefreshAll<br>    <SPAN style="color:#007F00">'Call macro1</SPAN><br>    Call ScanInOut_Click<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Alfordm]

Cheers for the suggestion. I'll give it a try & get back to you in a day or so.
I'm exploring an alternative to the 'ActiveWorkbook.Save / RefreshAll' that's been gave me a headache & will post if succesful.
Mat

 

[Alfordm]

With thanks for your assistance. I tweaked it a little to come up with the below which seems to work well.

Private Sub ScanInOut_Click()

    Dim found As Boolean
    Dim Check As Boolean
    Dim strName As String
    Dim strCode As String
    Dim dtmNow As Date
    Dim Counter As Integer
    Dim rfnd As Range
    

        strCode = InputBox(Prompt:="Please Enter Your Pass Code.", Title:="ENTER YOUR CODE", default:="Your Pass Code Here")
              
        If strCode = "Your Pass Code Here" Or strCode = vbNullString Then
        'MsgBox ("Error, default values were not updated in the 'Name' boxes")
        CreateObject("Wscript.Shell").Popup "Error, Please try again", 1, "Auto-Close", 0
        Exit Sub
        End 
If
                            
            strCode = Trim(strCode) 'trim blank characters
            strCode = StrConv(strCode, vbUpperCase) 'convert all to UPPER case
            'Check = False 'seemed like a good idea
 
            Set rfnd = Sheets("Admin Sheet").Range("U:U").Find (what:=strCode, LookIn:=xlValues,lookat:=xlWhole,Searchorder:=xlByRows,searchdirection:=xlNext)
                    If rfnd Is Nothing Then 'strCode not found
                        CreateObject("Wscript.Shell").Popup "Name is not in list. Please see Admin.", 1, "Auto-Close", 0
                        
                        Call ScanInOut_Click 'repeat the process
                        Exit Sub
                    
Else
                    End If
                    

                        If ActiveWorkbook.MultiUserEditing Then ' this activates if this is a shared workbook & brings over all otheer changes
                            
ActiveWorkbook.AcceptAllChanges
                        End If
                            
                            If Sheets("Admin Sheet").Range("O13") = "Yes" Then 'sets if "time rounding" process is to be followed
                                dtmNow = Sheets("Admin Sheet").Range("O15")
                                
Else
                                dtmNow = Now
                             End If
                             

                                'Find last occurance of strCode in column A:A
                                Set rfnd = Sheets("Admin Sheet").Range("A:A").Find(what:=strCode,after:=[A1], LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
                                 If Not rfnd Is Nothing Then ' strCode found
                                    If rfnd.Offset(0, 6) = "" Then 'need to punch out
                                        rfnd.Offset(0, 6).NumberFormat = "d/mm/yyyy h:mm"
                                        rfnd.Offset(0, 6) = dtmNow
                                    
CreateObject("Wscript.Shell").Popup "Punched out", 1, "Auto-Close", 0

                                     Else ' find last entry in column & make a new entry
                                        GoTo NewEntry
                                    End If
                                    
                                
Else    'code & blank cell not found, New Entry required
NewEntry:
                                     Set rfnd = Sheets("Admin Sheet").Range("A:A").Find(what:="*", after:=[A1], searchdirection:=xlPrevious)
                                        
rfnd.Offset(1, 0).NumberFormat = "@"                                        
rfnd.Offset(1, 0) = strCode                                        
rfnd.Offset(1, 5).NumberFormat = "d/mm/yyyy h:mm"
rfnd.Offset(1, 5) = dtmNow
                                    
CreateObject("Wscript.Shell").Popup "Punched in", 1, "Auto-Close", 0

                    End If
                    Call ScanInOut_Click
End Sub