Results 1 to 2 of 2
  1. #1
    Star Lounger
    Join Date
    Jun 2010
    Location
    Lichfield, UK
    Posts
    56
    Thanks
    10
    Thanked 0 Times in 0 Posts

    VBA Seems to hang with Excel UserForm

    I have an application in Excel using a UserForm and VBA. The application uses a number of spreadsheets to generate reports. The main spreadsheet I am using is called the Generator because it generates reports by sucking data out of another spreadsheet, cleaning it, transforming it and then outputting it to a third template spreadsheet. The system has been working well for months. However I am in the process of adding some new functionality and have hit a problem I do not understand.
    The new functionality is on a UserForm where I capture the requirements of a new report. Rather than put the controls on the UserForm itself I have used multipage control as this gives me the option of more easily migrating other existing functionality to the UserForm using additional tabs on the multipage control in future (other data is currently captured on a worksheet in the Generator which you will see behind the UserForm in the screenshots in attached document).
    So I enter the parameters on the multipage tab and then click on a Confirm button on the same multipage tab. I then have code which goes to the template file to verify whether all of the required range names are present. After that it shifts focus to a second tab on the multipage which will be used to show progress on the report generation and display issues. That all happens perfectly. At the end of the process I have a message dialog box to show it is complete, but this dialog does not display. The only way I can get it to display is by switching focus between the VBA IDE and the Generator spreadsheet on the Task bar and then pressing the Control key. Whilst I am doing this Excel is clocking up about 25% of CPU time constantly.
    However:
    1 - If I put a break point at the beginning of the code in cmdConfirm_Click and then step through it a line at a time there is no delay. The message box is displayed immediately.
    2 - I have also added a "Debug.Print "Starting : " & Now()" statement at the top of the cmdConfirm_Click code and appended "Now()" to the message in the Message Box. The time displayed in the message box is 1 second later than that shown in the Debug.Print statement, so something is blocking that message box from being displayed.

    I have put screenshots in the attached file and the code is displayed below.

    Can anyone give me any clues as to what I should be looking for. Many thanks.

    Windows 7 (64 bit), Excel 2010


    Code:
        Private Enum ETCDFields
            EName = 1
            ENumber = 2
            EFunction = 4
            ECountry = 8
            ERegion = 16
            EEMailAddress = 32
            EDateGenerated = 64
            ELACode = 128
            ELADesc = 256
            EType = 512
            ELevel = 1024
            EDuration = 2048
            ERefresher = 4096
            ECurHeader = 8192
        End Enum
    
    
    
    Private Sub cmdConfirm_Click()
    
        On Error GoTo Err_cmdConfirm_Click
    
        Dim iLoop As Integer
    
        Dim lngField As Long                                            ' Identifies the field whose existence in the ETCD template we are verifying
        Dim lngMissingFields As Long                                    ' Identifies any fields missing in the ETCD template
        Dim lngTCDCount As Long
        
        Dim strTemp As String
                                                                        
        Debug.Print "Starting - " & Now()                       'testing
                                                                        
                                                                        
                                                                        
                                                                        ' Check we have selected some Employees to print
        If lstSelected.ListCount = 0 Then
            iMsg = MsgBox("There are no Employees selected", vbOKOnly, constNAME & strBusinessUnit & " (" & constVERSION & ")")
            Exit Sub
        End If
        
                                                                        ' Check both the Upload sheet and the ETCD Template are both open
        If CheckWorkbooks(True, False, False, False, True, True) = False Then
            Exit Sub
        End If
        
                                                                        ' Verify that the ETCD template contains all of the Range Names that
                                                                        '  we will need. Some are mandatory other are optional and controlled
                                                                        '  by parameters
        wbkETCD.Activate
        
        lngMissingFields = 0
        
        lngField = EName
        strTemp = Range("ETName").Address
        
        lngField = ENumber
        strTemp = Range("ETNumber").Address
        
        lngField = EFunction
        strTemp = Range("ETFunction").Address
        
        lngField = ECountry
        strTemp = Range("ETCountry").Address
        
        lngField = ERegion
        strTemp = Range("ETRegion").Address
        
        lngField = EEMailAddress
        strTemp = Range("ETEMailAddress").Address
        
        lngField = EDateGenerated
        strTemp = Range("ETDateGenerated").Address
    
        lngField = ELACode
        strTemp = Range("TCCode").Address
        
        lngField = ELADesc
        strTemp = Range("TCTitle").Address
        
        lngField = EType
        strTemp = Range("TCType").Address
        
        lngField = ELevel
        strTemp = Range("TCLevel").Address
        
        lngField = EDuration
        strTemp = Range("TCDuration").Address
        
        lngField = ERefresher
        strTemp = Range("TCRefresher").Address
        
        lngField = ECurHeader
        strTemp = Range("CurHeader").Address
        
        wbkGenerator.Activate
        
    
        
        Application.ScreenUpdating = True
      
        lngField = 0
        If lngMissingFields > 0 Then
            strTemp = "E-G999 - The following field(s) are missing from the ETCD Template:" & vbCrLf & vbCrLf
            strTemp = strTemp & IIf((lngMissingFields And EName) = 0, "", "Employee Name" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ENumber) = 0, "", "Employee Number" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And EFunction) = 0, "", "Employee Function" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ECountry) = 0, "", "Employee Country" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ERegion) = 0, "", "Employee Region" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And EEMailAddress) = 0, "", "Employee eMail Address" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And EDateGenerated) = 0, "", "Date Generated" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ELACode) = 0, "", "Learning Activity Code" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ELADesc) = 0, "", "Learning Activity Description" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And EType) = 0, "", "Type of Training" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ELevel) = 0, "", "Level of Training" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And EDuration) = 0, "", "Duration of Training" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ERefresher) = 0, "", "Refresher Training" & vbCrLf)
            strTemp = strTemp & IIf((lngMissingFields And ECurHeader) = 0, "", "Curriculum Sheet Header" & vbCrLf)
            strTemp = strTemp & vbCrLf & "You must fix the template before continuing."
            iMsg = MsgBox(strTemp, vbOKOnly, constNAME & strBusinessUnit & " (" & constVERSION & ")")
            Exit Sub
        End If
            
    
            
        For iLoop = 0 To lstSelected.ListCount - 1
            lngEmpRow(iLoop) = lstSelected.Column(0, iLoop)
            lngEmpNo(iLoop) = lstSelected.Column(1, iLoop)
            strEmpName(iLoop) = lstSelected.Column(2, iLoop)
        Next iLoop
        
        lngToPrint = lstSelected.ListCount
        lngPrinted = 0
    
        mpMain.Pages("pgeETCDProgress").Visible = True
        mpMain.Pages("pgeETCDProgress").Enabled = True
        mpMain.Value = 1
    
        txtToPrint = lngToPrint
        txtPrinted = lngPrinted
        
        
        
        
        Debug.Print "Finished - " & Now()                       'testing
    
        iMsg = MsgBox(lngTCDCount & " Employee TCDs have been generated - " & Now(), vbOKOnly, constNAME & strBusinessUnit & " (" & constVERSION & ")")
    
    Exit_cmdConfirm_Click:
        Exit Sub
    
    Err_cmdConfirm_Click:
        If Err.Number = 1004 And lngField > 0 Then
            lngMissingFields = lngMissingFields + lngField
            Resume Next
        Else
            iMsg = MsgBox("An error has occurred in frmEntry Sub cmdConfirm_Click()." & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, _
                vbOKOnly, constNAME & strBusinessUnit & " (" & constVERSION & ")")
            Resume Exit_cmdConfirm_Click
        End If
        
    End Sub
    Attached Files Attached Files

  2. #2
    Star Lounger
    Join Date
    Jun 2010
    Location
    Lichfield, UK
    Posts
    56
    Thanks
    10
    Thanked 0 Times in 0 Posts
    I've solved it - after much head scratching.

    The function CheckWorkbooks() is called to verify that all the sheets it needs are open and it tries to display what it finds on some traffic lights on the Entry sheet of the Generator. As the UserForm is open modally it cannot do this so this is what was holding it up.

    Thanks to those who may have spent time looking at this.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •