Prevent Screen Flicker when Showing Progress bar Userform

Hi It has been a while but found an issue I cant seem to work out.

I have a userform with a progress bar that I want to update as the script runs. I got the progress bar script from Andy Pope web site and tried to insert my logic, Everything runs except I have a large amount of screen flicker, but only in the part in red below, after this completes the rest of the progress bar has no flicker.

As you can see below I tried to make the progress bar update as my logic updates records, however I may be going about this the wrong way. If I don't update the bar is this way then the bar holds on 1 till all the updates are complete then moves pretty quick to 100 %

I would like to keep the progress bar moving as each update are completed, I had to place the "DD" in to count the rows so the bar would not go past 100 % I'm sure someone will have a better understanding of what I mean by reading through the code below.

Thanks as always for any help you can provide.
Mike

Note: All this code is in the Userform

Sub DemoProgress1()
' Progress Bar

    Dim objConn As New ADODB.Connection, objRs As New ADODB.Recordset
    Dim ObjCommand As New ADODB.Command
    Dim UserId, password, Library As String
    Dim intIndex As Integer
    Dim sngPercent As Single
    Dim intMax As Integer

Frame1.Visible = True

  

    intMax = 100
    For intIndex = 1 To intMax
        sngPercent = intIndex / intMax
        ProgressStyle1 sngPercent, True
        DoEvents
        '------------------------
        ' Your code would go here
        If KeepShowing = True Then GoTo 10
        
        Application.ScreenUpdating = False
        With Sheets(1)
            
            UserId = "THISUSER"
            password = "GENERIC"
            Library = "MYLIB"
        
        objConn.ConnectionString = "DSN=QDSN_2222.RITE;DRIVER=Client Access ODBC Driver (32-bit); " & _
                               "SYSTEM = 2222.RITE; UID = " & UserId & _
                               ";PWD = " & password
        objConn.Open

            'Delete the records first Dont Need if using Date Function
        objConn.Execute "DELETE FROM " & Library & ".RITENAME"
        objRs.Open "SELECT * FROM " & Library & ".RITENAME", objConn, adOpenDynamic, adLockOptimistic
' Loop


        LROW = .Cells(Rows.Count, 1).End(xlUp).Row
        DD = LROW / 3
        

            For RowCount = 3 To LROW
                    objRs.AddNew
                    objRs.Fields(0) = .Cells(RowCount, 1).Value             'OPERATION
                    objRs.Fields(1) = .Cells(RowCount, 2).Value             'OP NUM
                    objRs.Fields(2) = .Cells(RowCount, 3).Value             'OP DESC
                    objRs.Fields(3) = .Cells(RowCount, 4).Value             'WAREHOUSE
                    objRs.Fields(4) = .Cells(RowCount, 5).Value             'OP DESC
                    objRs.Fields(5) = .Cells(RowCount, 6).Value             'TIMUP
                    objRs.UpDate
            
                If intIndex <= DD Then
                
                intIndex = intIndex + 1
                sngPercent = intIndex / intMax
                ProgressStyle1 sngPercent, True
                
                End If
            Me.Repaint
            Next RowCount


        objRs.Close
        objConn.Close
            Set objRs = Nothing
            Set objConn = Nothing
    
   
        End With
   Application.ScreenUpdating = True
   KeepShowing = True
        '------------------------
10
        Sleep 100
       
    Next


KeepShowing = False
Me.Hide

Sub ProgressStyle1(Percent As Single, ShowValue As Boolean)
'need this
' Progress Style 1
' Label Over Label
'
    Const PAD = "                                                                                     "
    
    If ShowValue Then
        labPg1v.Caption = PAD & Format(Percent, "0%")
        labPg1va.Caption = labPg1v.Caption
        labPg1va.Width = labPg1.Width
    End If
    labPg1.Width = Int(labPg1.Tag * Percent)

End Sub