user form infinit loop

[Paulo]

hi,

I am designing a Data base.
for feeling it out, I am designing a Userform.
my userform, have a Combobox that by been selected, feels in couple
txtboxes with data from the worksheet.
when I am done, editing the textboxes, I have the button Edit, that will
paste the new values on the worksheet.
My problem is, when I edit, the combobox_change code runs and i get myself
into a infinit loop. is therea way to tel the code not to go there on change?

 

[Joel]

Turn of events at beginning to code and turn them back on at the end

Application.EnableEvents = False

Application.EnableEvents = True

 

[Paulo]

didnt work,

Private Sub CmdEditar_Click()
Application.EnableEvents = False
... code...
Range("c" & seriaL).Value = ndtcontratO
(here is when the programs calls CmbEmpresa_Change) and output's Infinit loop
... code...
Unload Me
Application.EnableEvents = True
Exit Sub
trataErro:
MsgBox Error & " " & Err
End Sub

 

[Joel]

I think you need to step through the code to determine what is happening.

click on the line Range("c" & seriaL).Value = ndtcontratO

then Press F9 to set a break point. Start the code the way you would
normally do and the macro should stop on the line with the break point. Then
type F8 to step through code. You can add more break points and use F5 to
run until next break or until the end. I can't see from the code provided
what is causing the inifinite loop.

 

[Paulo]

I have posted the .xls file here:
http://rapidshare.com/files/159024980/Meu_DB_FORM_0.2.xls.html

try sheet "Menu">Editar dados>combobox "Paulo"> insert some text on OBS
(dont forget to check the box)> Editar

thanks for helping out Paul.

 

[Joel]

I used the View - Call Stack to find where the problem was. I looked like
changing the selection of the worksheet was causing a false change of you
userform. I suspect that the userform and the worksheet visible at the same
time created the problem.

In the code below I eliminated any SELECTs in the code. This seemed to
solve the problem.




Option Explicit
Dim linhA As Long
Dim colunA As Long


Private Sub cbxAgente_Click()
If cbxAgente = False Then TxtAgente.Enabled = False
If cbxAgente = True Then TxtAgente.Enabled = True
End Sub

Private Sub cbxComissao_Click()
If cbxComissao = False Then TxtComissao.Enabled = False
If cbxComissao = True Then TxtComissao.Enabled = True
End Sub

Private Sub cbxDtContrato_Click()
If cbxDtContrato = False Then TxtDtContrato.Enabled = False
If cbxDtContrato = True Then TxtDtContrato.Enabled = True
End Sub

Private Sub cbxFator_Click()
If cbxFator = False Then TxtFator.Enabled = False
If cbxFator = True Then TxtFator.Enabled = True
End Sub

Private Sub cbxFomFix_Click()
If cbxFomFix = False Then TxtFomFix.Enabled = False
If cbxFomFix = True Then TxtFomFix.Enabled = True
End Sub

Private Sub cbxFomVar_Click()
If cbxFomVar = False Then TxtFomVar.Enabled = False
If cbxFomVar = True Then TxtFomVar.Enabled = True
End Sub

Private Sub cbxMora_Click()
If cbxMora = False Then TxtMora.Enabled = False
If cbxMora = True Then TxtMora.Enabled = True
End Sub

Private Sub cbxObs_Click()
If cbxObs = False Then TxtObs.Enabled = False
If cbxObs = True Then TxtObs.Enabled = True
End Sub

Private Sub cbxTaxa_Click()
If cbxTaxa = False Then TxtTaxa.Enabled = False
If cbxTaxa = True Then TxtTaxa.Enabled = True
End Sub

Private Sub CmbEmpresa_Change()
'On Error GoTo trataErro
Application.ScreenUpdating = False
' CmbEmpresa.RowSource = clientes: Column (1)
'Atual
TxtDtContrato.Enabled = False
TxtDtContrato = Format(CmbEmpresa.Column(2), "dd/mm/yyyy")
TxtAgente.Enabled = False
TxtAgente = CmbEmpresa.Column(3)
TxtComissao.Enabled = False
TxtComissao = CmbEmpresa.Column(4)
TxtTaxa.Enabled = False
TxtTaxa = CmbEmpresa.Column(5)
TxtFator.Enabled = False
TxtFator = CmbEmpresa.Column(6)
TxtMora.Enabled = False
TxtMora = CmbEmpresa.Column(7)
TxtFomFix.Enabled = False
TxtFomFix = CmbEmpresa.Column(8)
TxtFomVar.Enabled = False
TxtFomVar = CmbEmpresa.Column(9)
TxtObs.Enabled = False
TxtObs = CmbEmpresa.Column(10)

'Anterior
Dim empresA As String
Dim empLastnum As Long
Dim empCounter As Long
Dim empvalue As String
Dim seriaL As Long
Dim linEmp

empresA = CmbEmpresa.Column(1)
With Sheets("audit")
seriaL = 1 + .Range("A65000").End(xlUp).Value

Do Until seriaL = 1
empvalue = .Range("B" & seriaL).Value
linEmp = .Range("B" & seriaL).Row
If empvalue = empresA Then
LblDtcontratoV = .Range("D" & linEmp).Value
LblAgenteV = .Range("F" & linEmp).Value
LblComissaoV = .Range("H" & linEmp).Value
LblTaxaV = .Range("J" & linEmp).Value
LblFatorV = .Range("L" & linEmp).Value
LblMoraV = .Range("N" & linEmp).Value
LblFomFixV = .Range("P" & linEmp).Value
LblFomVarV = .Range("R" & linEmp).Value
LblObsV = .Range("T" & linEmp).Value
Exit Do
End If
seriaL = seriaL - 1
Loop
End With

If empvalue <> empresA Then
LblDtcontratoV = " - "
LblAgenteV = " - "
LblComissaoV = " - "
LblTaxaV = " - "
LblFatorV = " - "
LblMoraV = " - "
LblFomFixV = " - "
LblFomVarV = " - "
LblObsV = " - "
'MsgBox "Auditoria anterior para esta empresa não encontrada."
End If
'Percentil
If IsDate(LblDtcontratoV) = True And IsDate(TxtDtContrato) = True Then _
LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV)
If IsNumeric(LblAgenteV) = True And IsNumeric(TxtAgente) Then _
LblAgenteP = (LblAgenteV / TxtAgente) * 100
If IsNumeric(LblComissaoV) = True And IsNumeric(TxtComissao) Then _
LblComissaoP = (LblComissaoV / TxtComissao) * 100
If IsNumeric(LblTaxaV) = True And IsNumeric(TxtTaxa) Then _
LblTaxaP = (LblTaxaV / TxtTaxa) * 100
If IsNumeric(LblFatorV) = True And IsNumeric(TxtFator) Then _
LblFatorP = (LblFatorV / TxtFator) * 100
If IsNumeric(LblMoraV) = True And IsNumeric(TxtMora) Then _
LblMoraP = (LblMoraV / TxtMora) * 100
If IsNumeric(LblFomFixV) = True And IsNumeric(TxtFomFix) Then _
LblFomFixP = (LblFomFixV / TxtFomFix) * 100
If IsNumeric(LblFomVarV) = True And IsNumeric(TxtFomVar) Then _
LblFomVarP = (LblFomVarV / TxtFomVar) * 100
Application.ScreenUpdating = True

Exit Sub
trataErro:
MsgBox Error & " " & Err
End Sub


Private Sub CmdCancel_Click()

Unload Me

End Sub


Private Sub CmdEditar_Click()
Application.EnableEvents = False
'On Error GoTo trataErro

Dim seriaL As Long
Dim emponchnG As String
Dim empresA As String
Dim dtcontratO As Date
Dim ndtcontratO As Date
Dim agentE As Long
Dim nagentE As Long
Dim comissaO As Double
Dim ncomissaO As Double
Dim taxA As Double
Dim ntaxA As Double
Dim fatoR As Double
Dim nfatoR As Double
Dim morA As Double
Dim nmorA As Double
Dim fomfixO As Double
Dim nfomfixO As Double
Dim fomvaR As Double
Dim nfomvaR As Double
Dim obS As String
Dim nobS As String
Dim LastCell As Range

'coleta
empresA = CmbEmpresa.Column(1)
dtcontratO = Format(CmbEmpresa.Column(2), "dd/mm/yyyy")
agentE = CmbEmpresa.Column(3)
comissaO = CmbEmpresa.Column(4)
taxA = CmbEmpresa.Column(5)
fatoR = CmbEmpresa.Column(6)
morA = CmbEmpresa.Column(7)
fomfixO = CmbEmpresa.Column(8)
fomvaR = CmbEmpresa.Column(9)
obS = CmbEmpresa.Column(10)

ndtcontratO = TxtDtContrato.Value
nagentE = TxtAgente.Value
ncomissaO = TxtComissao.Value
ntaxA = TxtTaxa.Value
nfatoR = TxtFator.Value
nmorA = TxtMora.Value
nfomfixO = TxtFomFix.Value
nfomvaR = TxtFomVar.Value
nobS = TxtObs.Value
'DB

'Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
'Sheets("BD").Unprotect = ""
With Sheets("BD")
.Visible = True
seriaL = .Range("A65000").End(xlUp).Value + 1
Do Until seriaL = 1
emponchnG = .Range("B" & seriaL).Value
If emponchnG = empresA Then
Application.EnableEvents = False
.Range("c" & seriaL).Value = ndtcontratO
.Range("d" & seriaL).Value = nagentE
.Range("e" & seriaL).Value = ncomissaO
.Range("f" & seriaL).Value = ntaxA
.Range("g" & seriaL).Value = nfatoR
.Range("h" & seriaL).Value = nmorA
.Range("i" & seriaL).Value = nfomfixO
.Range("j" & seriaL).Value = nfomvaR
.Range("k" & seriaL).Value = nobS
.Range("l" & seriaL).Value = Format(Right(ndtcontratO, 2), "000")

'Sheets("BD").Protect = ""
'Sheets("BD").Visible = False
End If
seriaL = seriaL - 1
Loop
End With
'AUDIT
'Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
'Sheets("BD").Unprotect = ""
Sheets("AUDIT").Visible = True
With Sheets("AUDIT")
seriaL = .Range("a65000").End(xlUp).Value
If IsNumeric(seriaL) = False Then seriaL = 1
Set LastCell = .Range("a" & Rows.Count).End(xlUp)
With LastCell
.Offset(1, 0).EntireRow.Insert
.Offset(1, 0) = seriaL + 1
.Offset(1, 1) = empresA
.Offset(1, 2) = Date
.Offset(1, 3) = dtcontratO
.Offset(1, 4) = ndtcontratO
.Offset(1, 5) = agentE
.Offset(1, 6) = nagentE
.Offset(1, 7) = comissaO
.Offset(1, 8) = ncomissaO
.Offset(1, 9) = taxA
.Offset(1, 10) = ntaxA
.Offset(1, 11) = fatoR
.Offset(1, 12) = nfatoR
.Offset(1, 13) = morA
.Offset(1, 14) = nmorA
.Offset(1, 15) = fomfixO
.Offset(1, 16) = nfomfixO
.Offset(1, 17) = fomvaR
.Offset(1, 18) = nfomvaR
.Offset(1, 19) = obS
.Offset(1, 20) = nobS
End With
End With
Unload Me
Application.EnableEvents = True
Exit Sub
trataErro:
MsgBox Error & " " & Err
End Sub


Private Sub TxtAgente_Change()
If TxtAgente <> "" Then If IsNumeric(LblAgenteV) = True And
IsNumeric(TxtAgente) Then _
LblAgenteP = (LblAgenteV / TxtAgente) * 100
End Sub

Private Sub TxtComissao_Change()
If TxtComissao <> "" Then If IsNumeric(LblComissaoV) = True And
IsNumeric(TxtComissao) Then _
LblComissaoP = (LblComissaoV / TxtComissao) * 100
End Sub

Private Sub TxtDtContrato_Change()
If TxtDtContrato <> "" Then If IsDate(LblDtcontratoV) = True And
IsDate(TxtDtContrato) = True Then _
LblDtcontratoP = DateValue(TxtDtContrato) - DateValue(LblDtcontratoV)
End Sub

Private Sub TxtFator_Change()
If TxtFator <> "" Then If IsNumeric(LblFatorV) = True And
IsNumeric(TxtFator) Then _
LblFatorP = (LblFatorV / TxtFator) * 100
End Sub

Private Sub TxtFomFix_Change()
If TxtFomFix <> "" Then If IsNumeric(LblFomFixV) = True And
IsNumeric(TxtFomFix) Then _
LblFomFixP = (LblFomFixV / TxtFomFix) * 100
End Sub

Private Sub TxtFomVar_Change()
If TxtFomVar <> "" Then If IsNumeric(LblFomVarV) = True And
IsNumeric(TxtFomVar) Then _
LblFomVarP = (LblFomVarV / TxtFomVar) * 100
End Sub

Private Sub TxtMora_Change()
If TxtMora <> "" Then If IsNumeric(LblMoraV) = True And
IsNumeric(TxtMora) Then _
LblMoraP = (LblMoraV / TxtMora) * 100
End Sub

Private Sub TxtTaxa_Change()
If TxtTaxa <> "" Then If IsNumeric(LblTaxaV) = True And
IsNumeric(TxtTaxa) Then _
LblTaxaP = (LblTaxaV / TxtTaxa)
End Sub

 

[Paulo]

yES, iT Did solve the loop. thank you.

I have to read a couple more time to see what you have done.
thank you very much