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.