If I just copy your loop code:
Sub EFG()
qValue = 4
QCount = 0
Do Until QCount = qValue
QCount = QCount + 1
Debug.Print QCount
Loop
End Sub
it works fine, so there doesn't appear to be a problem in the loop itself.
I would suggest doing the check at the end of the loop so you don't have to
duplicate your code in two places.
To debug, just put a msgbox inside the loop to display the values of
interest (QCount and qValue)
I see you have errhandler instructions commented out - if you are testing
with no error handling and getting the problem, then it probably isn't your
error handling, but if the error handling is being used in your testing, it
could be a contributor.
--
Regards,
Tom Ogilvy
"ewan7279" wrote:
> Hi Mike,
>
> I've posted the section of code below so you can check if I am overlooking
> something. Everything works until the loop is entered, from where it never
> exits.
>
> 'On Error GoTo ErrorHandler
> ActiveSheet.Unprotect
> ActiveWorkbook.Unprotect
>
> Dim deptsheet, homefile, Qbook, Q1sheet, Q2sheet, Q3sheet, Q4sheet As Variant
> Dim qvalue, QCount, sheetcount As Integer
>
> homefile = ActiveWorkbook.Name
>
> Dim Message, Title, Default
> Message = "Please enter the number of the current quarter (1 to 4)"
> Title = "Enter Quarter"
> Default = "1"
> qvalue = InputBox(Message, Title, Default)
>
> If qvalue > 4 Then
> MsgBox "Sorry, incorrect quarter entered. Please try again", vbOKOnly,
> "Error!!"
> Exit Sub
> Else
> If qvalue = 1 Then
> sheetcount = Workbooks(homefile).Sheets.Count
> Application.ScreenUpdating = True
> MsgBox "Please select the Q" & qvalue & " file", vbOKOnly, "Select Q" &
> qvalue & " File"
> Qbook = Application.GetOpenFilename()
> a = MsgBox("Open " & Qbook & "?", vbYesNoCancel, "Open Q" & qvalue & "
> file")
> If a = vbNo Then
> 'GoTo ErrorHandler
>
> Else
> If a = vbCancel Then
> 'GoTo ErrorHandler
>
> End If
> End If
> Application.ScreenUpdating = False
> Workbooks.OpenText Qbook
> Qbook = ActiveWorkbook.Name
> ActiveWorkbook.Unprotect
> Sheets(1).Select
> deptsheet = ActiveSheet.Name
>
> Windows(Qbook).Activate
> Sheets(deptsheet).Select
> Sheets(deptsheet).Copy After:=Workbooks(homefile).Sheets(sheetcount)
> ActiveSheet.Name = "Dept Card Q" & qvalue
>
> Dim Links As Variant
> Dim i As Integer
> ActiveSheet.Unprotect
> With ActiveWorkbook
> Links = .LinkSources(xlExcelLinks)
> If Not IsEmpty(Links) Then
> For i = 1 To UBound(Links)
> .BreakLink Links(i), xlLinkTypeExcelLinks
> Next i
> End If
> End With
> ActiveSheet.Protect
> Workbooks(Qbook).Close savechanges:=False
> Workbooks(homefile).Activate
> 'Sheets(1).Delete
>
> Else
>
> QCount = 0
> Do Until QCount = qvalue
> QCount = QCount + 1
> sheetcount = Workbooks(homefile).Sheets.Count
> Application.ScreenUpdating = True
> MsgBox "Please select the Q" & QCount & " file", vbOKOnly, "Select Q" &
> QCount & " File"
> Qbook = Application.GetOpenFilename()
> a = MsgBox("Open " & Qbook & "?", vbYesNoCancel, "Open Q" & QCount & "
> file")
> If a = vbNo Then
> 'GoTo ErrorHandler
>
> Else
> If a = vbCancel Then
> 'GoTo ErrorHandler
>
> End If
> End If
> Application.ScreenUpdating = False
> Workbooks.OpenText Qbook
> Qbook = ActiveWorkbook.Name
> ActiveWorkbook.Unprotect
> Sheets(1).Select
> deptsheet = ActiveSheet.Name
>
> Windows(Qbook).Activate
> Sheets(deptsheet).Select
> Sheets(deptsheet).Copy After:=Workbooks(homefile).Sheets(sheetcount)
> ActiveSheet.Name = "Dept Card Q" & QCount
>
> ActiveSheet.Unprotect
> With ActiveWorkbook
> Links = .LinkSources(xlExcelLinks)
> If Not IsEmpty(Links) Then
> For i = 1 To UBound(Links)
> .BreakLink Links(i), xlLinkTypeExcelLinks
> Next i
> End If
> End With
> ActiveSheet.Protect
> Workbooks(Qbook).Close savechanges:=False
>
> Loop
> End If
> End If
>
> etc etc etc
>
> "Mike H" wrote:
>
> > Hi,
> >
> > Then you are going to have to clarify what you mean by
> >
> > It just doesn't work in this loop...
> >
> > The code I posted works, if your doesnt then something in your code may be
> > changing the value of qvalue so that it and Qcount can neve be equal.
> >
> > Mike
> >
> >
> > "ewan7279" wrote:
> >
> > > Hi Mike,
> > >
> > > Sorry, I should have included that I have already declared qvalue as an
> > > integer variable and it still does not work. The inputbox value (qvalue)
> > > works in an if statement before the loop, and there is a validation also to
> > > check the value entered does not exceed 4, with a msgbox resulting if it
> > > does. It just doesn't work in this loop...
> > >
> > > Any ideas?
> > > Thanks.
> > >
> > > "Mike H" wrote:
> > >
> > > > Hi,
> > > >
> > > > Your inputbox is returning a text string so qvalue will never equal qcoount
> > > > hence the endless loop. Try this:-
> > > >
> > > >
> > > > Sub sonic()
> > > > Dim Message, Title, Default
> > > > Dim qvalue As Integer
> > > > Message = "Please enter the number of the current quarter (1 to 4)"
> > > > Title = "Enter Quarter"
> > > > Default = 1
> > > >
> > > > qvalue = InputBox(Message, Title, Default)
> > > >
> > > > Do Until qcount = qvalue
> > > > qcount = qcount + 1
> > > > 'my code here
> > > > Loop
> > > > MsgBox qcount
> > > > End Sub
> > > >
> > > > Mike
> > > >
> > > >
> > > > "ewan7279" wrote:
> > > >
> > > > > Hi all,
> > > > >
> > > > > I cannot work out why this isn't working. The user inputs a number from 1
> > > > > to 4 into an inputbox, and I want the macro to loop for this number of times
> > > > > (if 1 is entered, an if statement avoids this loop).
> > > > >
> > > > > My code is as below, but the loop just keeps on going for any number
> > > > > entered...
> > > > >
> > > > > Dim Message, Title, Default
> > > > > Message = "Please enter the number of the current quarter (1 to 4)"
> > > > > Title = "Enter Quarter"
> > > > > Default = "1"
> > > > >
> > > > > qvalue = InputBox(Message, Title, Default)
> > > > >
> > > > > Do Until QCount = qvalue
> > > > > QCount = QCount + 1
> > > > > 'my code here
> > > > > Loop
> > > > >
> > > > > Any ideas?
> > > > > Thanks,
> > > > > Ewan.
Similar Threads
