Solved VBA code to exit sub if combobox selection not found in data

July 21, 2016 at 05:03:34
Specs: Windows 7
I have a combobox that executes perfectly using the value selected from combobox. It searches the data for the value and runs through the routine. The problem I have is when it does not find the data it freezes on me and gives me an out of memory error. How can i incorporate code to give me a msg box that data is not found and exit sub?

Sub DropDown311_Change()
ActiveSheet.Unprotect
Dim mysht As Worksheet
Dim myDropDown As Shape
Dim myValSA As String

Set mysht = ThisWorkbook.Worksheets("Pipeline")
Set myDropDown = mysht.Shapes("Drop Down 311")
myValSA = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value)

If myValSA = "Remove Filters" Then Call Pipeline_Remove_All_Filters
    If myValSA = "Net Regs" Then Call Pipeline_ShowNetRegs
    If myValSA = "CIAPPR" Then Call PipelineShowCIAPPRLoans
    If myValSA = "APPR" Then Call PipelineShowAPPROVEDLoans
    'End If
Worksheets("Pipeline").Shapes("Drop Down 311").ControlFormat.Value = 1
End Sub 

message edited by mecerrato


See More: VBA code to exit sub if combobox selection not found in data

Reply ↓  Report •


✔ Best Answer
July 21, 2016 at 11:56:27
re: Single Stepping - "Just tried that and discovered where it freezes"

It's amazing what some simple debugging techniques will do for you, isn't it? ;-)

Have you reviewed the following tutorial? Single Stepping, Watches, Break Points and Run To Cursor are all extremely powerful debugging techniques. As you have seen, just running the code full speed and then trying to find the bugs based on the results, or worse yet on a crash, can be a very frustrating practice.

http://www.computing.net/howtos/sho...

Before I address your specific issue, please keep in mind that it is next to impossible for any of us to duplicate your workbook structure and actually run your code. The best we can do is try to troubleshoot your issues by reviewing the "text" of your code and hopefully understand what it is supposed to do. At that point, it's up to you to test our suggestions or tell us what we missed so we can try again.

That said...

It appears to me that this instruction sets a Range variable (rng) to the range of cells displayed once the Filter as been applied.

' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))

Have you looked at the address of rng? e.g. rng.address?

If I understand your problem correctly, you are ending up with an "empty" range if Criteria1 is not found. Therefore rng.address probably reads something like
$A$6:$H$1048576.

If that is the case, then you could check the address and not call the function if the Filter results are empty.

Set Rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))
   If Rng.Address = "$A$6:$H$1048576" Then
      MsgBox "Criteria Not Found"
      Exit Sub
   Else: 'Do whatever you want with the results of the Filter
End If

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
July 21, 2016 at 06:09:23
I'm not sure what you mean by "It searches the data for the value and runs through the routine. " I don't see any Search or Find instructions in the code you posted.

Have you Single Stepped through the code to see what is going on?

I ran your code using 5 choices for the Drop Down and simple MsgBox routines for the 4 choices in your code. When the 5th "unlisted" choice is selected, the code simply stops and returns control to Excel. i.e. No error messages.

My simple code:

Sub Pipeline_Remove_All_Filters()
   MsgBox "Pipeline_Remove_All_Filters"
End Sub

Do you have anything after the ControlFormat.Value = 1 instruction beside the End Sub? Perhaps the problem is not with the code you posted, but with something after the 4 If instructions.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#2
July 21, 2016 at 07:15:42
DerbyDad I just realized I didn't ask the write question nor did I use
the right code in the post, let me start over:

I have a macro that emails a range of data based on the combobox
selection. When the user selects a value (this becomes MyValBranch in
the code) which then becomes Criteria1 in my AutoFilter Field 31 in the
code . If it does not find the value of the MyValBranch variable in the
AutoFilter range the sheet freezes and I have to kill it though task
manager.

Sorry but I used the wrong code in my original post (just realized), this
is the correct code

Sub Pipeline_EmailBranchNetRegs()
ActiveSheet.Unprotect
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim mysht As Worksheet
Dim myDropDown As Shape
Dim myValBranch As String
Dim RegRng As Range
Dim ADRng As Range
Dim BMRng As Range
Dim PrevRegRng As Range

Set mysht = ThisWorkbook.Worksheets("Pipeline")
Set myDropDown = mysht.Shapes("Drop Down 264")
myValBranch = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value)
If myValBranch = "Choose Branch" Then
        MsgBox "Please Choose a Branch, then try again.", vbExclamation
        Exit Sub
    End If
Set RegRng = Worksheets("Goals").Range("A:A").Find(What:=myValBranch, LookAt:=xlWhole)
Set ADRng = Worksheets("Goals").Range("L:L").Find(What:=myValBranch, LookAt:=xlWhole)
Set BMRng = Worksheets("Goals").Range("M:M").Find(What:=myValBranch, LookAt:=xlWhole)
Set PrevRegRng = Worksheets("Goals").Range("A:A").Find(What:=myValBranch, LookAt:=xlWhole)

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval"
ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=31, Criteria1:=myValBranch
NumberofRegs = RegRng.Offset(0, 9).Value
AD = RegRng.Offset(0, 11).Value
BM = RegRng.Offset(0, 12).Value
Goal = RegRng.Offset(0, 1).Value
FormattedGoal = Format(Goal, "#,##0")

PrevNumberofRegs = PrevRegRng.Offset(0, 10).Value

Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))

If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected. " & _
           vbNewLine & "Please correct and try again.", vbOKOnly
    Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
   .Display
End With
Signature = OutMail.HTMLBody
strbody = "Snapshot of Current Pipeline and MTD Registration Count:" & "<br />" & "Current Month Goal = " & "$ " & FormattedGoal & "<br />" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & Split(ActiveSheet.Range("B2").Text, ".")(0) & "<br />" & "Previous Month Registration Count = " & PrevNumberofRegs & "<br />" & "MTD Registration Count = " & NumberofRegs
'Split(ActiveSheet.Range("B2").Text, ".")(0)
With OutMail
    .to = BM
    .cc = AD
    .Subject = myValBranch & " - " & "Net Reg Pipeline"
    .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
    .Display
End With

On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
ActiveSheet.Protect

End Sub


Reply ↓  Report •

#3
July 21, 2016 at 07:27:02
I'll ask again:

Have you Single Stepped through the code to see what is going on?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

Related Solutions

#4
July 21, 2016 at 07:50:20
Just tried that and discovered where it freezes, I am calling a function
named RangetoHTML that I found on the web, it is freezing on this
line RangetoHTML = ts.ReadAll.

But couldn't I stop the call to this function if the Criteria1 is not found in
the search range and incorporate something to stop it from calling the
function?

here is the full code for the function:

Function RangetoHTML(rng As Range)
ActiveSheet.Unprotect
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Borders.LineStyle = xlContinuous
    rng.Copy
    'rng.Borders.LineStyle = xlNone
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
ActiveSheet.Protect
End Function


Reply ↓  Report •

#5
July 21, 2016 at 11:56:27
✔ Best Answer
re: Single Stepping - "Just tried that and discovered where it freezes"

It's amazing what some simple debugging techniques will do for you, isn't it? ;-)

Have you reviewed the following tutorial? Single Stepping, Watches, Break Points and Run To Cursor are all extremely powerful debugging techniques. As you have seen, just running the code full speed and then trying to find the bugs based on the results, or worse yet on a crash, can be a very frustrating practice.

http://www.computing.net/howtos/sho...

Before I address your specific issue, please keep in mind that it is next to impossible for any of us to duplicate your workbook structure and actually run your code. The best we can do is try to troubleshoot your issues by reviewing the "text" of your code and hopefully understand what it is supposed to do. At that point, it's up to you to test our suggestions or tell us what we missed so we can try again.

That said...

It appears to me that this instruction sets a Range variable (rng) to the range of cells displayed once the Filter as been applied.

' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))

Have you looked at the address of rng? e.g. rng.address?

If I understand your problem correctly, you are ending up with an "empty" range if Criteria1 is not found. Therefore rng.address probably reads something like
$A$6:$H$1048576.

If that is the case, then you could check the address and not call the function if the Filter results are empty.

Set Rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))
   If Rng.Address = "$A$6:$H$1048576" Then
      MsgBox "Criteria Not Found"
      Exit Sub
   Else: 'Do whatever you want with the results of the Filter
End If

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#6
July 21, 2016 at 12:27:55
Another option:

Count how many cells in Range(rng) contain data. If 0, don't call the function.

Set Rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))
   If WorksheetFunction.CountA(Range(Rng.Address)) = 0 Then
      MsgBox "Criteria Not Found"
      Exit Sub
   Else: 'Do whatever you want with the results of the Filter
End If

There are a number of other options. Play around. Learn stuff. ;-)

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Reply ↓  Report •

#7
July 21, 2016 at 15:33:28
The first option worked, thank you sir, and the debugging lesson was very helpful :-)

Reply ↓  Report •


Ask Question