End If: Choosing Yes or No, doesn't matter as the msgBox just repeats itself.

[Greg Bonaparte]

The  following  macro  worked fine  for a  long time. One day  it began looping at  the "a = MsgBox("HAVE YOU ENTERED YOUR 'ACCOUNT VALUE'? HAVE YOU TESTED NEW, 'UNIQUE SYMBOLS'?", vbQuestion + vbYesNo, "HonorSystem24")".   Choosing Yes or No, doesn't matter as the msgBox just repeats itself. Can anyone find an issue?

Sub FILTER()
Application.Calculation = xlManual

Range("BF3881").Select
Selection.Copy
Range("BF41").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BF41").Select
Selection.AutoFill Destination:=Range("BF41:BF3880"), Type:=xlFillDefault

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"B41:B3880"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B41:BE3880")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
"B41:B3880"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("B41:BE3880")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B41").Select
Selection.End(xlDown).Select
Range("B3880").Select


Range("BH14").Select
Selection.Copy
Range("BI2").Select
ActiveSheet.Paste
Selection.AutoFill Destination:=Range("BI2:BI14"), Type:=xlFillDefault
Range("BI2:BI14").Select


Application.Calculation = xlManual
Dim rng As Range
Dim lr As Integer
Set rng = Range("B41:C3880")
lr = WorksheetFunction.CountA(rng) + 40


With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = False
End With
'
Range("B41").Select
Selection.End(xlDown).Select

Range("C3881:BE3881").Select
Selection.Copy

Range("C" & lr).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False




Range("BG2:BH2").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
a = MsgBox("HAVE YOU ENTERED YOUR 'ACCOUNT VALUE'? HAVE YOU TESTED NEW, 'UNIQUE SYMBOLS'?", vbQuestion + vbYesNo, "HonorSystem24")
If a = vbYes Then

Range("BG14").Select
Selection.Copy
Range("BI2").Select
ActiveSheet.Paste

Call WATCH

ElseIf a = vbNo Then
End If
End Sub

[#2]

@Greg Bonaparte 

A sub-routine named WATCH is being called after the msgbox prompt,what is in there?

Also, always post your code within the code tags, you will find a option in the formatting toolbar above as </> and if you click it, a new window will be popped up, paste your code in there and then post it.

It is always easy to read a code within the code tags.

[#3]

x

[#4]

Sub FILTER()
        Application.Calculation = xlManual
        
        Range("BF3881").Select
        Selection.Copy
        Range("BF41").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("BF41").Select
        Selection.AutoFill Destination:=Range("BF41:BF3880"), Type:=xlFillDefault
        
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
        "B41:B3880"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B41:BE3880")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
        "B41:B3880"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B41:BE3880")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
        Range("B41").Select
        Selection.End(xlDown).Select
        Range("B3880").Select
        
        
        Range("BH14").Select
        Selection.Copy
        Range("BI2").Select
        ActiveSheet.Paste
        Selection.AutoFill Destination:=Range("BI2:BI14"), Type:=xlFillDefault
        Range("BI2:BI14").Select
    
       
           Application.Calculation = xlManual
        Dim rng As Range
        Dim lr As Integer
        Set rng = Range("B41:C3880")
        lr = WorksheetFunction.CountA(rng) + 40
        
        
        With Application
            .ScreenUpdating = True
            .DisplayStatusBar = True
            .EnableEvents = False
        End With
'
    Range("B41").Select
    Selection.End(xlDown).Select

    
    Range("C3881:BE3881").Select
    Selection.Copy

    Range("C" & lr).Select
  
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
       
       
       
       
        Range("BG2:BH2").Select
        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
        a = MsgBox("HAVE YOU ENTERED YOUR 'ACCOUNT VALUE'? HAVE YOU TESTED NEW, 'UNIQUE SYMBOLS'?", vbQuestion + vbYesNo, "HonorSystem24")
        If a = vbYes Then

        Range("BG14").Select
        Selection.Copy
        Range("BI2").Select
        ActiveSheet.Paste

        Call WATCH

        ElseIf a = vbNo Then
        End If
        End Sub

Sub WATCH()
        Application.Calculation = xlManual
       
       Range("BG3:BH3").Select
        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        ActiveSheet.Range("$BG$36:$BI$3880").AutoFilter Field:=1


        Application.EnableEvents = True
        a = MsgBox("ARE YOU READY TO REBALANCE PORTFOLIO?", vbQuestion + vbYesNo, "HonorSystem24")
        If a = vbYes Then

        Range("BG14").Select
        Selection.Copy
        Range("BI3").Select
        ActiveSheet.Paste
        Call Save
        ElseIf a = vbNo Then
        End If
        End Sub

@Subodh_Tiwari_sktneer 

[#5 · Accepted solution]

@Greg Bonaparte 

I cannot replicate the issue you are talking about.

When I clicked "Yes" in the first msgbox prompt, a new msgbox popped out with Yes and No and it doesn't repeat the first msgbox again no matter whether I click on Yes or No in the second msgbox.

And if I click on No on the first msgbox, the second msgbox doesn't appear at all with no repetition of the first msgbox.

So everything is working as desired or Am I missing something?

[#6]

Ok I suspect the issue is with Windows10. A new update has my computer acting erratic. The erratic is triggered by specific action such as "turning off a browser extension" or as in this case, "arriving at this msgbox". Thank you for confirming code is good. It explains why the loop started happening  after zero changes where made to the code.@Subodh_Tiwari_sktneer