VBA vbYesNo Inquiry - excel

I am trying to create a message box that will give the user the option to continue or stop if their search comes up with more than 1000 results. I have the message box made, but I don't know how to code the vbYes and the vbNo to either continue on with the code (vbYes) or to end the script (vbNO).
Here is my code.
Sub FindOne()
Range("B19:J5000") = ""
Application.ScreenUpdating = False
Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer
Dim myText As String
Dim totalValues As Long
Dim nextCell As Range
Dim searchAllCheck As Boolean
k = ThisWorkbook.Worksheets.Count
myText = ComboBox1.Value
Set nextCell = Range("B20")
If myText = "" Then
MsgBox "No Address Found"
Exit Sub
End If
Select Case ComboBox2.Value
Case "SEARCH ALL"
searchAllCheck = True
Case "EQUIPMENT NUMBER"
searchColumn = 1
Case "EQUIPMENT DESCRIPTION"
searchColumn = 3
Case "DUPONT NUMBER"
searchColumn = 6
Case "SAP NUMBER"
searchColumn = 7
Case "SSI NUMBER"
searchColumn = 8
Case "PART DESCRIPTION"
searchColumn = 9
Case ""
MsgBox "Please select a value for what you are searching by."
End Select
For I = 2 To k
totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row
ReDim AddressArray(totalValues) As String
If searchAllCheck Then
searchAllCount = 5
searchColumn = 1
Else
searchAllCount = 0
End If
For qwerty = 0 To searchAllCount
If searchAllCount Then
Select Case qwerty
Case "1"
searchColumn = 3
Case "2"
searchColumn = 6
Case "3"
searchColumn = 7
Case "4"
searchColumn = 8
Case "5"
searchColumn = 9
End Select
End If
For j = 0 To totalValues
AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value
Next j
If totalValues > 1000 Then
Results = MsgBox("Your Search has Returned Over 1000 Results. Continuing Could Cause Excel to Slow Down or Crash. Do you Wish to Continue?", vbYesNo + vbExclamation, "Warning")
End If
If Results = vbNo Then
End
End If
If Results = vbYes Then
For j = 0 To totalValues
If InStr(1, AddressArray(j), myText) > 0 Then
EndPasteLoop = 1
If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1
For r = 1 To EndPasteLoop
Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value
Set nextCell = nextCell.Offset(1, 0)
Next r
End If
Next j
Else
End
End If
Next qwerty
Next I
Debug.Print tc
Application.ScreenUpdating = True
End Sub

If I understood your problem, you have to compare the "Results" variable if is vbYes or vbNo.
Below a little and simple example.
If MsgBox("Continue?", vbYesNo,"Confirmation") = vbYes Then
'code if yes
Else
'End
End If
Hope that helps. ;)

vbYes is a constant, a member of an enum called VbMsgBoxResult that defines a bunch of related constants, including vbYes and vbNo.
If vbYes Then
That's like saying
If 42 Then
You have a constant expression that evaluates to a Long integer, and an If statement works with a Boolean expression that evaluates to a Boolean value (True/False).
You need to compare vbYes to something to get that Boolean expression.
If Results = vbYes Then

Related

input and check of values from input box

please help where is the error.
loop without IF?
I need to load the code, check the first 2 values match the cell. Check that you do not duplicate in column A. And retrieve the codes until the required number is reached.
Thank you
My Code:
Sub novy()
Dim aText(1) As Variant
Dim n As Integer
Dim vstup As String
vstup = InputBox(aText(x))
Set hledat = Range("A:A").Find(what:=vstup, LookIn:=xlValues, LookAt:=xlWhole)
If vstup = "" Then ' in case the use press "Cancel"
i = MsgBox("Chcete ukončit načítání?", vbYesNo)
Select Case i
Case vbYes
Exit Sub
Case vbNo
Call novy
End Select
ElseIf Left(vstup, 2) <> Range("D3").Formula Then
i = MsgBox("jiný modul!", vbExclamation)
ElseIf hledat Is Nothing Then
For n = 1 To 10
aText(1) = "Načti kód"
Sheets("data").Select
aLastRow = Cells(1, 1).CurrentRegion.Rows.Count + 1
For x = 1 To 1
Cells(aLastRow, x) = vstup
Next
Cells(10, 9) = n
'MsgBox n
Next n
MsgBox "Bedna je hotová"
Else
i = MsgBox("modul byl už načten!", vbExclamation)
End If
End Sub
You have an error on the the two last for loops. you dont need 2 either with an "x" from 1 to 1..
For n = 1 To 10
aText(1) = "Načti kód"
Sheets("data").Select
aLastRow = Cells(1, 1).CurrentRegion.Rows.Count + 1
Cells(aLastRow, 1) = vstup
Next

VBA Userform Listbox Conditional Logic Not Working as Intended

I have a Userform with a listbox for which I am using conditional logic to determine output values to the sheet of selected or non-selected items in the listbox. The issue is that when the Textbox (Tbl_AliasName) is blank, the code executes this:
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
But if Tbl_AliasName is not blank then the code does nothing, but it is supposed to do this:
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
I have used several variations of If statements, and non of which have worked.
Below is My Code:
Option Explicit
Public Tbl_AliasName As String
Tbl_AliasName = Trim(UserForm_Finder.txtConcat.Value)
Private Sub BtnConcat_Click()
Dim k As Long, lstbxRow As Long, LR As Long
lstbxRow = 1
'****************
'This if statement works perfectly
If (Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) _
And Tbl_AliasName = vbNullString Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf (UserForm_Finder.ListBx_TblsCols.ListCount = 0 And Tbl_AliasName <> vbNullString) Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
'(Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) And _
Exit Sub
End If
With UserForm_Finder.ListBx_TblsCols
For k = 0 To .ListCount - 1
'****************
This is where the problems begin
If .Selected(k) = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
End If
Next k
End With
End Sub
My goal is to do the following:
If a Textbox (Tbl_AliasName) is not blank and the user has selected one or more items in the listbox (ListBx_TbleCols) then concatenate the Tbl_AliasName to the selected items in the listbox
If Tbl_AliasName is blank, then use the value in Cells(2,1) to concatenate to the selected Items in the list box.
I have tried the following additions:
Dim LstBxItemSelected As Boolean
'This was placed in the for loop
LstBxItemSelected = True
'this was placed outside the for loop
If LstBxItemSelected = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
End If
Is there a better way to tell if items are selected, because I feel that the way I have it structured in my loop, the code will throw the error if everything isn't selected? Thank you in advance for any ideas, answers, or suggestions!
Note: The Listbox is populated by the click of another button on the userform which calls the following sub:
Sub FillLstBxCols()
Dim ListBx_Target As MSForms.ListBox
Dim rngSource As Range
Dim LR As Long
If Cells(2, 1).Value2 <> vbNullString Then
LR = Worksheets("New TRAX").Cells(Rows.Count, 2).End(xlUp).Row
'Set reference to the range of data to be filled
Set rngSource = Worksheets("New Trax").Range("A" & 2 & ":" & "B" & LR)
'Fill the listbox
Set ListBx_Target = UserForm_Finder.ListBx_TblsCols
With ListBx_Target
.RowSource = rngSource.Address
End With
End If
End Sub
Hard to say without sample data and expected results, but I think this is what you're looking for:
Private Sub btnConcat_Click()
Dim ws As Worksheet
Dim bSelected As Boolean
Dim sConcat As String
Dim i As Long, lRowIndex As Long
Set ws = ActiveWorkbook.Sheets("New TRAX")
lRowIndex = 1
bSelected = False
sConcat = Trim(Me.txtConcat.Text)
If Len(sConcat) = 0 Then sConcat = Trim(ws.Cells(2, "A").Value)
If Len(sConcat) = 0 Then
MsgBox "You must Search for a Table or Column first.", vbExclamation, "Error Encountered"
Exit Sub
End If
For i = 0 To Me.ListBx_TblsCols.ListCount - 1
If Me.ListBx_TblsCols.Selected(i) Then
If bSelected = False Then
bSelected = True
ws.Range("C2", ws.Cells(ws.Rows.Count, "C")).Clear 'clear previous concat results (delete this line if not needed)
End If
lRowIndex = lRowIndex + 1
ws.Cells(lRowIndex, "C").Value = sConcat & "." & Me.ListBx_TblsCols.List(i)
End If
Next i
If bSelected = False Then MsgBox "Must select at least one item from the list"
End Sub

Search via Keyword and not String

I am working on a project where I search an entire workbook and then have the results shown on a search page. So far I have it down to being able to search for a string and it finding that string. But if I just search for a keyword like "motor" it will show no results because no where in the workbook is just "motor" written in a cell. Is their any way that I can make it so that it will search for any thing that is typed in the search box?
Here is the code. The search script is Sub FindOne()
Private Sub ComboBox1_Change()
End Sub
Private Sub ComboBox2_Change()
UpdateSearchBox
End Sub
Private Sub CommandButton1_Click()
Select Case TextBox1.Value
Case "F"
TextBox1.Value = "G"
Case "E"
TextBox1.Value = "F"
Case "D"
TextBox1.Value = "E"
Case "C"
TextBox1.Value = "D"
Case "B"
TextBox1.Value = "C"
Case "A"
TextBox1.Value = "B"
Case "G"
TextBox1.Value = "A"
End Select
End Sub
Private Sub CommandButton2_Click()
FindOne
End Sub
Private Sub TextBox1_Change()
UpdateSearchBox
End Sub
Sub UpdateSearchBox()
Dim PageName As String, searchColumn As String, ListFiller As String
Dim lastRow As Long
If TextBox1.Value <> "" Then
PageName = TextBox1.Value
Else
Exit Sub
End If
Select Case ComboBox2.Value
Case "EQUIPMENT NUMBER"
searchColumn = "A"
Case "EQUIPMENT NAME"
searchColumn = "C"
Case "DUPONT NUMBER"
searchColumn = "F"
Case "SAP NUMBER"
searchColumn = "G"
Case "SSI NUMBER"
searchColumn = "H"
Case "PART NAME"
searchColumn = "I"
Case ""
MsgBox "Please select a value for what you are searching by."
End Select
lastRow = Sheets(PageName).Range("A65536").End(xlUp).Row
If lastRow <> 0 And PageName <> "" And searchColumn <> "" Then
ListFiller = PageName & "!" & searchColumn & "2" & ":" & searchColumn & lastRow
ComboBox1.ListFillRange = ListFiller
End If
End Sub
Sub FindOne()
Range("B19:J1500") = ""
Application.ScreenUpdating = False
Dim k As Integer, EndPasteLoopa As Integer
Dim myText As String, searchColumn As String
Dim totalValues As Long
Dim nextCell As Range
k = ThisWorkbook.Worksheets.Count
myText = ComboBox1.Value
Set nextCell = Range("B20")
If myText = "" Then
MsgBox "No Address Found"
Exit Sub
End If
Select Case ComboBox2.Value
Case "EQUIPMENT NUMBER"
searchColumn = "A"
Case "EQUIPMENT NAME"
searchColumn = "C"
Case "DUPONT NUMBER"
searchColumn = "F"
Case "SAP NUMBER"
searchColumn = "G"
Case "SSI NUMBER"
searchColumn = "H"
Case "PART NAME"
searchColumn = "I"
Case ""
MsgBox "Please select a value for what you are searching by."
End Select
For i = 2 To k
totalValues = Sheets(i).Range("A65536").End(xlUp).Row
ReDim AddressArray(totalValues) As String
For j = 0 To totalValues
AddressArray(j) = Sheets(i).Range(searchColumn & j + 1).Value
Next j
For j = 0 To totalValues
If (myText = AddressArray(j)) Then
EndPasteLoop = 1
If (Sheets(i).Range(searchColumn & j + 2).Value = "") Then EndPasteLoop = Sheets(i).Range(searchColumn & j + 1).End(xlDown).Row - j - 1
For r = 1 To EndPasteLoop
Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(i).Range("A" & j + r, "I" & j + r).Value
Set nextCell = nextCell.Offset(1, 0)
Next r
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
I have no idea if this is even possible. Thank You!
Use the Instr function. Here is an example of how it works:
Dim startPosition As Integer
startPosition = InStr("find the comma, in the string", ",")
This bit of code will return 15, saying that the position there there is a , is the 15th position.
Now just adjust this for your code. Iterate over what you want to search through. If the InStr function does not return 0, you've got a (semi)match.
If you want to learn more, go to this question: Check if a string contains another string.
#A.S.H answered the question in the comments.

Increment a For loop inside an If statement -VBA

I need to delete columns in a spreadsheet using a loop instead of manually hardcoding those columns in. However all I get is a very unhelpful Next without For error.
Sub test()
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim colNum2 As Integer
colNum2 = 1
For x = 1 To 32
If Range("A1").Value = "Order No." Then
Next colNum
ElseIf Range("B1").Value = "Line No." Then
Next colNum
ElseIf Range("C1").Value = "Order Qty." Then
Next x
ElseIf Range("D1").Value = "PO" Then
Next x
ElseIf Range("E1").Value = "Sched Date" Then
Next x
ElseIf Range("F1").Value = "Sched MFG Line" Then
Next x
ElseIf Range("G1").Value = "Item No." Then
Next x
ElseIf Range("H1").Value = "Item Width" Then
Next x
ElseIf Range("I1").Value = "Item Height" Then
Next x
ElseIf Range("J1").Value = "SL Color" Then
Next x
ElseIf Range("K1").Value = "Frame Option" Then
Next x
End If
'Checks if the cell matches a specific string required by the sorter
'if TRUE should skip through to the next increment of colNum
Columns(colNum2).EntireColumn.Delete
'uses the current number of colNum to delete the current column number
colNum2 = colNum2 + 1
Next x
'increments colNum by one
'Iterates next through the loop
I feel like this would work with say Java or Python so I'm really irritated VBA won't let me do this.
Can someone please explain what is going wrong with this code?
Just use var = var + 1 instead of Next. Next ends the For cycle.
Also you don't need to repeat the variable name on the Next line since it's already in the For line. (For i = 0 To 5 ... Next)
For x = 1 To 32
If Range("A1").Value = "Order No." Then
colNum = colNum +1
ElseIf Range("C1").Value = "Order Qty." Then
x = x + 1
End If
Next
Keep in mind what Scott Cranner said, the Next will also do x=x+1, so if you only want to increment once per cycle, use the Do While cycle instead
x = 1
Do While x <= 32
If Range("A1").Value = "Order No." Then
colNum = colNum +1
ElseIf Range("C1").Value = "Order Qty." Then
x = x + 1
End If
Loop
It seems to me that you want to delete all of the columns that do not match 'a specific string required by the sorter'. In that case, you could loop through all of the columns header labels, deleting the ones that do not match or use a custom left-to-right sort to put all of the non-matching columns to the right and delete then en masse.
Method 1 - Delete non-matching columns
Sub test1()
Dim c As Long, vCOLs As Variant
vCOLs = Array("Order No.", "Line No.", "Order Qty.", "PO", _
"Sched Date", "Sched MFG Line", "Item No.", _
"Item Width", "Item Height", "SL Color", "Frame Option")
With Application
'.ScreenUpdating = False
'.EnableEvents = False
End With
With Worksheets("sheet1")
With .Cells(1, 1).CurrentRegion
'delete from right-to-left or risk missing one
For c = .Columns.Count To 1 Step -1
If IsError(Application.Match(.Cells(1, c).Value2, vCOLs, 0)) Then
.Columns(c).EntireColumn.Delete
End If
Next c
End With
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Method 2 - Custom sort, then offset and delete
Sub test2()
Dim vCOLs As Variant
vCOLs = Array("Order No.", "Line No.", "Order Qty.", "PO", _
"Sched Date", "Sched MFG Line", "Item No.", _
"Item Width", "Item Height", "SL Color", "Frame Option")
With Application
'.ScreenUpdating = False
'.EnableEvents = False
.AddCustomList ListArray:=vCOLs
End With
With Worksheets("sheet1")
With .Cells(1, 1).CurrentRegion
'custom sort to bring the important fields to the left
.Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
Orientation:=xlLeftToRight, Header:=xlNo, _
OrderCustom:=Application.GetCustomListNum(vCOLs)
'offset and delete the unwanted columns
With .Offset(0, Application.Match(vCOLs(UBound(vCOLs)), .Rows(1), 0))
.EntireColumn.Delete
End With
End With
End With
With Application
.DeleteCustomList .GetCustomListNum(vCOLs)
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
With either method you are simply listing the columns you want to keep and removing the rest.
There is a twist between .Cells.Sort.SortFields.Add and .Cells.Sort that usually generates some confusion. The .SortFields.Add method uses a CustomOrder:= parameter and the Range.Sort method uses a OrderCustom:= parameter. The two are most definitely NOT the same but often get used interchangeably with disastrous results.
I suspect you are trying to delete columns based on their text values in row 1. This will give you what you want, just put all the text references that you want to delete in the CASE statement.
Option Explicit
Sub DeleteColumns()
Dim colNum As Integer
colNum = 1
Do While Range(alphaCon(colNum) & 1).Value <> ""
Select Case Range(alphaCon(colNum) & 1).Value
Case "ColumnIDontWant", "AnotherColumnIDontWant"
Columns(colNum).EntireColumn.Delete
End Select
colNum = colNum + 1
Loop
End Sub
Public Function alphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
alphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
alphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
alphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function

Excel Find a sheet based on name

This is not a question, so much as a solution, but I wanted to share it here as I had gotten help for things I needed here.
I wanted to find a specific Excel sheet, in the Active Workbook, searching by the name of the sheet. I built this to find it. It is a "contains" search, and will automatically go to the sheet if it is found, or ask the user if there are multiple matches:
To end at any time, just enter a blank in the input box.
Public Sub Find_Tab_Search()
Dim sSearch As String
sSearch = ""
sSearch = InputBox("Enter Search", "Find Tab")
If Trim(sSearch) = "" Then Exit Sub
'MsgBox (sSearch)
Dim sSheets() As String
Dim sMatchMessage As String
Dim iWorksheets As Integer
Dim iCounter As Integer
Dim iMatches As Integer
Dim iMatch As Integer
Dim sGet As String
Dim sPrompt As String
iMatch = -1
iMatches = 0
sMatchMessage = ""
iWorksheets = Application.ActiveWorkbook.Sheets.Count
ReDim sSheets(iWorksheets)
'Put list of names in array
For iCounter = 1 To iWorksheets
sSheets(iCounter) = Application.ActiveWorkbook.Sheets(iCounter).Name
If InStr(1, sSheets(iCounter), sSearch, vbTextCompare) > 0 Then
iMatches = iMatches + 1
If iMatch = -1 Then iMatch = iCounter
sMatchMessage = sMatchMessage + CStr(iCounter) + ": " + sSheets(iCounter) + vbCrLf
End If
Next iCounter
Select Case iMatches
Case 0
'No Matches
MsgBox "No Match Found for " + sSearch
Case 1
'1 match activate the sheet
Application.ActiveWorkbook.Sheets(iMatch).Activate
Case Else
'More than 1 match. Ask them which sheet to go to
sGet = -1
sPrompt = "More than one match found. Please enter number from following list"
sPrompt = sPrompt + "to display the sheet" + vbCrLf + vbCrLf + sMatchMessage
sPrompt = sPrompt + vbCrLf + vbCrLf + "Enter blank to cancel"
sGet = InputBox(sPrompt, "Please select one")
If Trim(sGet) = "" Then Exit Sub
sPrompt = "Value must be a number" + vbCrLf + vbCrLf + sPrompt
Do While IsNumeric(sGet) = False
sGet = InputBox(sPrompt, "Please select one")
If Trim(sGet) = "" Then Exit Sub
Loop
iMatch = CInt(sGet)
Application.ActiveWorkbook.Sheets(iMatch).Activate
End Select
End Sub
I hope someone finds this useful, and would also welcome enhancement suggestions.
For fun tried to do this in as few lines as possible with loops
Uses a range name, xlm, and VBS under utilised Filter to provide the same multi-sheet search functionality as above.
The bulk of the code relates to the sheet selection portion
Sub GetNAmes()
Dim strIn As String
Dim X
strIn = Application.InputBox("Search string", "Enter string to find", ActiveSheet.Name, , , , , 2)
If strIn = "False" Then Exit Sub
ActiveWorkbook.Names.Add "shtNames", "=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND(""]"",GET.WORKBOOK(1)))"
X = Filter([index(shtNames,)], strIn, True, 1)
Select Case UBound(X)
Case Is > 0
strIn = Application.InputBox(Join(X, Chr(10)), "Multiple matches found - type position to select", , , , , 1)
If strIn = "False" Then Exit Sub
On Error Resume Next
Sheets(CStr(X(strIn))).Activate
On Error GoTo 0
Case 0
Sheets(X(0)).Activate
Case Else
MsgBox "No match"
End Select
End Sub

Resources