loop

Here is my current code (just a section)


Is there a loop that could possibly do this faster. Sometimes I load 100's of fields on the userform

        Dim intID As Integer
        Dim intRowNumber As Integer
        Dim strFirstName As String
        Dim strLastName As String
        
    
        intID = shVariables.Range("ID").Value


        
        
Application.ScreenUpdating = False

                shBorrower.Activate
                shBorrower.Range("A2").Select
                    Do
                        If ActiveCell.Value <> intID Then
                            ActiveCell.Offset(1, 0).Select
                        End If
                    Loop Until ActiveCell.Value = intID
                    
                        strFirstName = ActiveCell.Offset(0, 1).Value
                        strLastName = ActiveCell.Offset(0, 2).Value
                    
                        frmBorrower.txtFirstName = ActiveCell.Offset(0, 1).Value
                        frmBorrower.txtLastName = ActiveCell.Offset(0, 2).Value
                        frmBorrower.txtHomePhone = ActiveCell.Offset(0, 3).Value
                        frmBorrower.txtCellPhone = ActiveCell.Offset(0, 4).Value
                        frmBorrower.txtCompany = ActiveCell.Offset(0, 5).Value
                        frmBorrower.txtWorkPhone = ActiveCell.Offset(0, 6).Value
                        frmBorrower.txtEmail = ActiveCell.Offset(0, 7).Value
                        frmBorrower.txtSalutation = ActiveCell.Offset(0, 8).Value
                        frmborrower.txtTitle = ActiveCell.Offset(0,9).Value
                        frmBorrower.txtAddress = ActiveCell.Offset(0, 10).Value
                        frmBorrower.txtCity = ActiveCell.Offset(0, 11).Value
                        frmBorrower.cbxState = ActiveCell.Offset(0, 12).Value
                        frmBorrower.txtZip = ActiveCell.Offset(0, 13).Value
                        frmBorrower.cbxHearAboutUs = ActiveCell.Offset(0, 14).Value
                        frmBorrower.txtReferredBy = ActiveCell.Offset(0, 15).Value
                        frmBorrower.cbxReferralType = ActiveCell.Offset(0, 16).Value
                        frmBorrower.txtReferralDate = ActiveCell.Offset(0, 17).Value
                        frmBorrower.cbxStatus = ActiveCell.Offset(0, 18).Value



shMenu.Activate

Application.ScreenUpdating = True

Thanks for any help


Josh