Odd Behaviour With Code Results In RunTime vs Manually Stepping Through Same Code

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,570
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Please, I hope someone is able to help me out of a bind. Let me try to explain the process:

A userform opens to to real the 1st ("frm_s1") of 8 frames (each frame referred to as a "service") each containing a series of controls for the user to enter pieces of data-. Only frame 1 is visible, the other 7 are not. Each frame also has 3 bottons [-], which triggers code to delete the cuurent service, [END] which triggers code to process and submit the current service and end the entry of further services, and finally [+] whic when triggered processes and submits the cuurent service and then reveals the next service frame in the sequence. I am having problems with the code associated to the [+] function. A master worksheet remains visible behinbd the form and is updated respective of the buttons selected as part of the processing and submission.

The user form opens, service frame 1 is revealed, the user enters the data and presses [+]
to continue adding services by revealing the next service range in the sequence (#2 "frm_s2").
Code: 
Private Sub cbt_s1_add_Click()

    Me.cbt_s1_add.Enabled = False
    Me.btn_help.Visible = False
    Me.cbt_s1_del.Visible = True
   
    trnsvc_add Me, 1 '(proceduree, uf:frmservice, index)

End Sub

The problem resides in this code (trnsvc_add), specifically the section highlighted in orange.

Rich (BB code): 
Sub trnsvc_add(frmservice As Object, index As Long)
    Debug.Print srow
    Debug.Print cd_rrow
    ridno = ws_master.Cells(srow, 1)
   
    'run data check looking for missing information
    trn_srv_datachk frmservice, index
  
     'index is "service" number, frame number

    If index = 1 Then
        cdsvc_col = 38
        msrv_col = 13
        c_ul = 3 'cell unlock - number of cells to unlock after populated
    ElseIf index = 2 Then
        cdsvc_col = 45
        msrv_col = 14
        c_ul = 2
    ElseIf index = 3 Then
        cdsvc_col = 52
        msrv_col = 15
        c_ul = 1
    ElseIf index = 4 Then
        cdsvc_col = 59
        msrv_col = 16
        c_ul = 0
    ElseIf index = 5 Then
        cdsvc_col = 66
        msrv_col = 13
        c_ul = 0
    ElseIf index = 6 Then
        cdsvc_col = 73
        msrv_col = 14
        c_ul = 0
    ElseIf index = 7 Then
        cdsvc_col = 80
        msrv_col = 15
        c_ul = 0
    Else 'index = 8 Then
        cdsvc_col = 87
        msrv_col = 16
        c_ul = 0
    End If
   
   'core_data is a hidden worksheet that is considered the "database: and holds the values of the userform controls

    'update core_data
    With ws_cd
        .Unprotect
        If frmservice.Controls("cbx_s" & index & "_rln").Value = True Then
            .Cells(cd_rrow, cdsvc_col) = "RLN"
            st_msg = "Reline"
        Else
            .Cells(cd_rrow, cdsvc_col) = "CHG"
            st_msg = "Change"
        End If
        .Cells(cd_rrow, cdsvc_col + 1) = frmservice.Controls("tb_s" & index & "_lwr").Value
        .Cells(cd_rrow, cdsvc_col + 2) = frmservice.Controls("tb_s" & index & "_upr").Value
        .Cells(cd_rrow, cdsvc_col + 3) = frmservice.Controls("cb_s" & index & "_crew").Value
        .Cells(cd_rrow, cdsvc_col + 4) = frmservice.Controls("cb_s" & index & "_div").Value
        .Cells(cd_rrow, cdsvc_col + 5) = frmservice.Controls("cb_s" & index & "_base").Value
        .Cells(cd_rrow, cdsvc_col + 6) = frmservice.Controls("cb_s" & index & "_pitch").Value
        .Protect
    End With
   
    'ws_master is the worksheet behind the form that this code updates

    'update master: PDA bookings
    With ws_master
        mbevents = False
        .Unprotect
        .Range("M" & srow & ":P" & srow).Interior.Color = RGB(166, 166, 166)
        With .Cells(srow, msrv_col)
            .Value = frmservice.Controls("cb_s" & index & "_crew").Value
            .Interior.ColorIndex = 0
        End With
        If c_ul = 0 Then
            .Range("M" & srow & ":P" & srow).locked = False
        Else
            For L1 = msrv_col To msrv_col + c_ul
                .Cells(srow, L1).locked = False
            Next L1
        End If

    'update master: PDA services
        'determine destination row for service entry
        svc_lrow = Application.WorksheetFunction.Match("Facility Maintenance Activities", .Columns(1)) - 3 'last empty row before a new line has to be inserted
        Set rng_cntb = .Range("A13:A" & svc_lrow) 'service range
        er = Application.WorksheetFunction.CountBlank(rng_cntb)
        If er = 0 Then 'no empty rows in PDA service range insert a row
            MsgBox "Not enough room. Row added at " & svc_lrow + 1
            .Range("A" & svc_lrow + 1 & ":R" & svc_lrow + 1).Insert shift:=xlDown
            svc_drw = svc_lrow + 1
        Else
            svc_drw = rng_cntb.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
        End If
       
        'add static data
        Set rng_cpy = .Range("A" & srow & ":G" & srow)
        rng_cpy.Copy .Range("A" & svc_drw)
        
        'populate service data range (M-Q)
        .Range("H" & svc_drw & ":Q" & svc_drw).Interior.Color = RGB(166, 166, 166)
        With .Cells(svc_drw, msrv_col)
            .Value = frmservice.Controls("cb_s" & index & "_crew").Value
            .Interior.ColorIndex = 0
        End With

        'populate dispatch
        With .Cells(svc_drw, 2)
            tr_msg = frmservice.Controls("tb_s" & index & "_lwr").Value & "-" & frmservice.Controls("tb_s" & index & "_upr").Value
            .Value = st_msg & " " & tr_msg
            .Font.Bold = True
            .WrapText = True
            .HorizontalAlignment = xlCenter
            .Font.Color = vbBlack
        End With
        'format svc row
        .Rows(svc_drw).AutoFit
        .Range(.Cells(svc_drw, 1), .Cells(svc_drw, 17)).VerticalAlignment = xlCenter
       
        .Protect
        mbevents = True
    End With
    ftr = index + 1
    frmservice.Controls("frm_service" & ftr).Visible = True
  
End Sub

The issue:
After the press of the [+] button, worksheet core_data updates as coded.
The code in purple properly executes and provides the desired updates to that worksheet
The code in orange does NOT populate/format as coded IN RUNTIME! If I step through this code using F8, it works. Weird!
The next service frame (#2) is revealed allowing the user to enter data for that service.

It weirds out again here ... again, only in run time. Not with stepping through.
Pressing the [+] in service 2's frame will update core_data properly, the code in purple (respective of servic 2 data)... BUT ... now the update to worksheet master for service 1's orange code appears! (this should have been revealed as part of pressing [+] in service 1's frame. The orange code for service 2 does not update ws_master with service 2 data.

Here is the code for service 2's [+] button, mind you the update described above occurs before this code is encountered. (ie it updates then stops at the stop line)
Code: 
Private Sub cbt_s2_add_Click()
    Stop
    Me.cbt_s2_add.Enabled = False
    trnsvc_add Me, 2
End Sub

My project is several 100s of lines of code and utilizes data from several independent and closed workbooks to work. For that, it isn't possible for me to provide the file to experiment with unfortunately. I hope its a simple error as it has put my project in a hold. I hope I've provided appropriate and sufficient information. If not, please ask.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
hello. without knowing the structure of your data and any underkying queries, is it possible that data refreshes are not completing? If this is possible, add the following line to your code to force a wait while data is refreshed:

Application.CalculateUntilAsyncQueriesDone​

 
Upvote 0
Thank jmclearly ... any place in particular would be best to put this line? Before the orange code?
 
Upvote 0
So, I added that line between the purple and orange sections of my code and there was no difference. I appreciate the effort though.
I wish I could share my workbook so that folks would experience the issue. I'm certainly at a loss and if the diehards are at a loss, I'm feeling pretty discouraged. LOL
 
Upvote 0
Ark68 said:
So, I added that line between the purple and orange sections of my code and there was no difference. I appreciate the effort though.
Click to expand...
I have never used that command before myself, but typically you would place them at the very top of your code.
 
Upvote 0
Thanks Joe, I tried that, and no change sadly.
While anxiously trying to find a solution to this, I had made some changes to my code (ws_master cell formatting changes). The modified code was part of the original purple section. Interestingly now, the purple section which originally managed to be fulfilled in runtime, is behaving the same as the orange section. Now, even the purple section doesn't populate properly in runtime, but it does when stepped through. It makes me wonder if the proper worksheet (aka ws_master) is active and receiving the effects of it's code.

Here is the new code if anyone feels comparing the two might reveal something. Orange does not work in run time. Dark orange was the original purple code that once worked and no longer works. The is code that was added ...

Rich (BB code): 
Sub trnsvc_add(frmservice As Object, index As Long)
    Application.CalculateUntilAsyncQueriesDone
    Dim msrv_col As Long
    'Stop
    Debug.Print srow
    Debug.Print cd_rrow
  
  
    'srow = source(master) row (previously calculated when trn_srv = new)
    'cd_rrow = destination (core data) row (previously calculated when trn_srv = new)
    ridno = ws_master.Cells(srow, 1)
  
    'run data check looking for missing information
    trn_srv_datachk frmservice, index
    'update ws_cd
    If index = 1 Then
        cdsvc_col = 38
        msrv_col = 13
        c_ul = 3 'cell unlock - number of cells to unlock after populated
        uf_width = 366
        uf_height = 288
    ElseIf index = 2 Then
        cdsvc_col = 45
        msrv_col = 14
        c_ul = 2
        uf_width = 540
        uf_height = 288
    ElseIf index = 3 Then
        cdsvc_col = 52
        msrv_col = 15
        c_ul = 1
        uf_width = 713
        uf_height = 288
    ElseIf index = 4 Then
        cdsvc_col = 59
        msrv_col = 16
        c_ul = 0
        uf_width = 713
        uf_height = 479
    ElseIf index = 5 Then
        cdsvc_col = 66
        msrv_col = 13
        c_ul = 0
        uf_width = 713
        uf_height = 479
    ElseIf index = 6 Then
        cdsvc_col = 73
        msrv_col = 14
        c_ul = 0
        uf_width = 713
        uf_height = 479
    ElseIf index = 7 Then
        cdsvc_col = 80
        msrv_col = 15
        c_ul = 0
        uf_width = 713
        uf_height = 479
    Else 'index = 8 Then
        cdsvc_col = 87
        msrv_col = 16
        c_ul = 0
        uf_width = 713
        uf_height = 479
    End If
  
    'With frmservice
    '    .Width = uf_width
    '    .Height = uf_height
    '    .Top = Application.Top + (Application.UsableHeight / 2) - (.Height / 2)
    '    .Left = Application.Left + (Application.UsableWidth / 2) - (.Width / 2)
    'End With
  
    'update core_data
    With ws_cd
        .Unprotect
        If frmservice.Controls("cbx_s" & index & "_rln").Value = True Then
            .Cells(cd_rrow, cdsvc_col) = "RLN"
            st_msg = "Reline"
        Else
            .Cells(cd_rrow, cdsvc_col) = "CHG"
            st_msg = "Change"
        End If
        .Cells(cd_rrow, cdsvc_col + 1) = frmservice.Controls("tb_s" & index & "_lwr").Value
        .Cells(cd_rrow, cdsvc_col + 2) = frmservice.Controls("tb_s" & index & "_upr").Value
        .Cells(cd_rrow, cdsvc_col + 3) = frmservice.Controls("cb_s" & index & "_crew").Value
        .Cells(cd_rrow, cdsvc_col + 4) = frmservice.Controls("cb_s" & index & "_div").Value
        .Cells(cd_rrow, cdsvc_col + 5) = frmservice.Controls("cb_s" & index & "_base").Value
        .Cells(cd_rrow, cdsvc_col + 6) = frmservice.Controls("cb_s" & index & "_pitch").Value
        .Protect
    End With
    Stop
    'update master: PDA bookings
    With ws_master
        mbevents = False
        .Unprotect
        If index = 1 Then
            .Range("N" & srow & ":P" & srow).Interior.Color = RGB(166, 166, 166)
        End If
        If index = 2 Then
            .Range("O" & srow & ":P" & srow).Interior.Color = RGB(166, 166, 166)
        End If
        If index = 3 Then
            .Range("P" & srow & ":P" & srow).Interior.Color = RGB(166, 166, 166)
        End If
      
        With .Cells(srow, msrv_col)
            .Value = frmservice.Controls("cb_s" & index & "_crew").Value
            .Interior.ColorIndex = 0
        End With
        If c_ul = 0 Then
            .Range("M" & srow & ":P" & srow).locked = False
        Else
            For L1 = msrv_col To msrv_col + c_ul
                .Cells(srow, L1).locked = False
            Next L1
        End If
'Stop
    'update master: PDA services

        'determine destination row for service entry
        svc_lrow = Application.WorksheetFunction.Match("Facility Maintenance Activities", .Columns(1)) - 3 'last empty row before a new line has to be inserted
        Set rng_cntb = .Range("A13:A" & svc_lrow) 'service range
        er = Application.WorksheetFunction.CountBlank(rng_cntb)
        If er = 0 Then 'no empty rows in PDA service range insert a row
            MsgBox "Not enough room. Row added at " & svc_lrow + 1
            .Range("A" & svc_lrow + 1 & ":R" & svc_lrow + 1).Insert shift:=xlDown
            svc_drw = svc_lrow + 1
        Else
            svc_drw = rng_cntb.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
        End If
        
        'add static data
        Set rng_cpy = ws_master.Range("A" & srow & ":G" & srow)
        rng_cpy.Copy ws_master.Range("A" & svc_drw)
        
        'populate service data range (M-Q)
        .Range("H" & svc_drw & ":Q" & svc_drw).Interior.Color = RGB(166, 166, 166)
        With ws_master.Cells(svc_drw, msrv_col)
            .Value = frmservice.Controls("cb_s" & index & "_crew").Value
            .Interior.ColorIndex = 0
        End With
        'populate dispatch
        With .Cells(svc_drw, 2)
            tr_msg = frmservice.Controls("tb_s" & index & "_lwr").Value & "-" & frmservice.Controls("tb_s" & index & "_upr").Value
            .Value = st_msg & " " & tr_msg
            .Font.Bold = True
            .WrapText = True
            .HorizontalAlignment = xlCenter
            .Font.Color = vbBlack
        End With
        'format svc row
        .Rows(svc_drw).AutoFit
        .Rows(svc_drw).Cells.locked = True
        .Range(.Cells(svc_drw, 1), .Cells(svc_drw, 17)).VerticalAlignment = xlCenter
        
        .Protect
        mbevents = True
    End With
  
    With frmservice
        .Width = uf_width
        .Height = uf_height
        .Top = Application.Top + (Application.UsableHeight / 2) - (.Height / 2)
        .Left = Application.Left + (Application.UsableWidth / 2) - (.Width / 2)
        index = index + 1
        .Controls("frm_service" & index).Visible = True
    End With
  
 
End Sub
 
Upvote 0
Hi all that may be following this. I found the problem. Turns out that at some point in my code I disabled screenupdating and failed to re-enable it. Adding
Code: 
application.screenupdating = true
at the start of this module did seemed to have resolved the issue.

Thank you all who might have taken focus to try to provide a solution!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Userform Combobox Rowsource Contents Duplicated
Replies
4
Views
808
Ark68
A
A
  • Solved
Wrong Value In Trying To Determine Last Occupied Cell in A Column
2
Replies
13
Views
1K
Alex Blakenburg
A
A
  • Solved
IF Criteria Executing Code As If True When Should Be False
Replies
3
Views
516
Fluff
Fluff
A
  • Solved
Error Tying To Assign A Time Value TO A Variable
Replies
8
Views
571
JoeMo
J
W
  • Question Question
Running once through code does not give expected results, stepping through or running twice does
Replies
1
Views
417
Legacy 456129
L

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top