Academic Integrity: tutoring, explanations, and feedback — we don’t complete graded work or submit on a student’s behalf.

Loop command criteria not working in VBA code - tried various changes In my macr

ID: 3561321 • Letter: L

Question

Loop command criteria not working in VBA code - tried various changes

In my macro (to me it is rather a long one) I have a Do and Loop setting which basically includes almost all the rest of the code. The Do criteria is below:

Do Until Response = vbNo
Msg = "Do you want to chart a slice?"
Style = vbYesNo + vbDefaultButton2
Help = "DEMO.HLP"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
Exit Do
Exit Sub
End If

However, when the No button is clicked (say on the second or third loop) the code still wants to run as though I had clicked on Yes. I have tried moving the Loop end of the Do command to various places in the code but it still wants to treat No as Yes (if that makes sense). Anyway, I am not sure if I am missing out another part of the Do coding or whether I need to make the macro more specific with the Yes and No difference. I have never been very good with using Loop functions with codes and also not knowing whether certain parts can be made as their own sub-macros and be called into the main Sub.

I have put the full macro code below (minus sensitive information) below:


Sub Main2()

Dim Message As String
Dim Client As String
Dim StartDate As String
Dim TankNum As Integer
Dim TankHeight As String
Dim LastTier As Integer
Dim increment As Integer

Dim Response As Boolean
Dim Msg As String
Dim Style As String
Dim Help As String
Dim Ctxt As Integer
Dim Tier As Integer

Dim K As Integer
Dim ender As Integer
Dim last As String
Dim starter As Integer
Dim sheetname1 As String
Dim Range1 As Range

Dim Devm As Single
Dim Rad As Double
Dim slice As String
Dim point As String
Dim Angle As Double
Dim Devmm As Integer
Dim height As String

Dim MainRange As Range
Dim CalcMode As Long
Dim ViewMode As Long
Dim sheetname2 As String
Dim SliceHeight As String

Message = "Enter Client name"
Client = InputBox(Message, Title)

Message = "Enter job Start Date as dd/mm/yy"
StartDate = InputBox(Message, Title)

Message = "Enter the Tank number"
TankNum = InputBox(Message, Title)

Message = "Enter the Full height of Tank"
TankHeight = InputBox(Message, Title)

Message = "Enter the number of slices"
LastTier = InputBox(Message, Title)

Message = "Enter the number of points"
increment = InputBox(Message, Title)

' ***********************************************************************
Do Until Response = vbNo
Msg = "Do you want to chart a slice?"
Style = vbYesNo + vbDefaultButton2
Help = "DEMO.HLP"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then
Exit Do
Exit Sub
End If
  
Message = "Enter required slice number from 1 to " & LastTier
Tier = InputBox(Message, Title)
If IsNull(Tier) Then
Exit Sub
End If
  
K = 1
ender = Tier * increment
last = LastTier * increment
starter = ender - (increment - 1)
If starter = 0 Then
starter = 1
End If
  
sheetname1 = "Sheet1"
ActiveSheet.Name = sheetname1
ActiveSheet.Range("K2") = TankHeight
ActiveSheet.Range("K3") = LastTier - 1
ActiveSheet.Range("K4").Formula = "=$K$2/$K$3"
ActiveSheet.Range("K6").Value = 360
ActiveSheet.Range("K7") = increment
ActiveSheet.Range("K8").Formula = "=$K$6/$K$7"
  
Set Range1 = Range("A1:J" & (last + 10))
With Range1
Rows(last + 2).Delete
End With
  
For K = starter To ender
Devm = ActiveSheet.Range("A" & K).Value
Rad = ActiveSheet.Range("B" & K).Value
slice = ActiveSheet.Range("C" & K).Value
point = ActiveSheet.Range("D" & K).Value
' ***Automation settings for Formulas and Autofill - all in one***
ActiveSheet.Range("E1:E" & last).Formula = "=(D1-1)*$K$8"
ActiveSheet.Range("F1:F" & last).Formula = "=A1*1000"
ActiveSheet.Range("G1:G" & last).Formula = "=(C1-1)*$K$4"
Angle = ActiveSheet.Range("E" & K).Value
Devmm = ActiveSheet.Range("F" & K).Value
height = ActiveSheet.Range("G" & K).Value

K = K + 1

ActiveSheet.Range("C1").Select

Next

Set MainRange = ActiveSheet.Range("C1:G" & K)
MainRange.Parent.Select
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = True
.EnableEvents = False
End With
  
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
  
MainRange.Parent.AutoFilterMode = False
MainRange.AutoFilter Field:=1, Criteria1:="=" & Tier
  
Sheets.Add
sheetname2 = "Slice" & Tier
ActiveSheet.Name = sheetname2
MainRange.Parent.AutoFilter.Range.Copy
With ActiveSheet.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
If Tier > 1 Then
Rows(1).Delete
End If
SliceHeight = ActiveSheet.Range("E2").Value
End With
  
MainRange.Parent.AutoFilterMode = False
MainRange.Parent.Select
ActiveWindow.View = ViewMode
Call deviationcharts(Title, Client, StartDate, TankNum, increment, Tier, sheetname2, SliceHeight)
Sheets("Sheet1").Select
  
Loop
End Sub

Explanation / Answer

<><><><><><><><>

Y^ou can resolve your problem by changing:

Dim Response As Boolean

to

Dim Response As Long

The constant vbNo has a value of 7 and, therefore, if Response is declared as a boolean, it will return a value of true if the No button is selected.

===