Nested If in VBA - excel

I've been tasked to correct someones code in VBA. I've never VBA programmed before so this is very basic.
Am I correct in assuming that after the first Then it checks if the next condition is true and thats where it executes the last line?
If data.Cells(i, 3 + 4).Value <> "" Then
If data.Cells(i, 2 + y).Value <> "" Then
tilqa = data.Cells(i, 2 + y)
End If

Whenever you have a question about the functioning of a code, try to write a small example, like the one below, with MsgBox(), showing exactly what is happening. The 1=1 and 2=2 is always evaluated to True:
Sub TestMe()
If 1 = 1 Then
If 2 = 2 Then
MsgBox "First check here!"
Else
MsgBox "This is not checked!"
End If
MsgBox "Then check here!"
End If
End Sub
Amd this is how the If-Else-End If may function without Else:
Sub TestMe()
If 1 = 1 Then
If 2 = 2 Then
MsgBox "First check here!"
End If
MsgBox "Then check here!"
End If
End Sub

Related

Find & Delete subroutine are not working in Excel

User enters the Waypoint id and then press delete record it, so data of that particular waypoint id should be delete from observations table.
Written a subroutine where my vba code first find the waypoint id in the observation worksheet, get the row number and then delete the row number and move the cell up. If it doesnot find the waypoint id then message should appear Waypoint id not found and cannot be deleted.
My vba code is not working. Can anyone help me to fix this issue? Attach File with name Problem.xlsm
Sub FindRecord(WyPt)
Dim Value As String
WyPtRow = 0
ReadRow = 2
Value = Cells(ReadRow, 2).Select 'Observation Sheet-WayPointID
While Value <> ""
If WyPt = Value Then
WyPtRow = ReadRow
Exit Sub
End If
ReadRow = ReadRow + 1
Value = Cells(ReadRow, 2)
Wend
End Sub
Sub DeleteRecord()
Set DEFrm = Sheets("DataEntryForm")
Set ObsData = Sheets("Observations")
WyPt = Trim(DEFrm.Cells(6, 2)) 'DataEntryForm worksheet-WayPointID
Call FindRecord(WyPt)
If WyPtRow > 0 Then
Worksheets("Observations").Rows(WyPtRow).Delete Shift:=xlShiftUp
MsgBox "WaypointID found", vbOKOnly + vbCritical, "Deleted Succesfully"
End If
If WyPtRow = 0 Then
MsgBox "WaypointID Not found", vbOKOnly + vbCritical, "We can't delete the record"
Exit Sub
End If
End Sub
I suggest you use application.match to find the row to delete.
I have not downloaded your file so this may need to adjustments.
Sub FindRecord()
Set DEFrm = Sheets("DataEntryForm")
WyPt = Trim(DEFrm.Cells(6, 2).value)
WyPtRow = application.match(WyPt, range("B:B"),0)
if not iserror(WyPtRow) then
DeleteRecord(WyPtRow)
else
msgbox "No waypoint found"
end if
End sub
Sub DeleteRecord(WyPtRow)
Worksheets("Observations").Rows(WyPtRow).EntireRow.Delete
End sub
Edit sorry I see now that I made the code in reverse.
My idea was to call FindRecord and it calls delete, I see now that you called Delete and it called find.
Try this code.
Sub DelRow(WyPt As String)
Dim i As Long
For i = 2 To 65536
If Cells(i, 2).Text = WyPt Then
Worksheets("Observations").Rows(i).Delete Shift:=xlShiftUp
MsgBox "WaypointID found", vbOKOnly + vbCritical, "Deleted Succesfully"
Exit Sub
End If
If Cells(i, 2).Text = "" Then 'stop on first empty row
Exit For
End If
Next
MsgBox "WaypointID Not found", vbOKOnly + vbCritical, "We can't delete the record"
End Sub

vba trouble working with cutomizable multiple Listbox with multiple macro

So here's my objective: I need to execute different macros deppending on a multiple choice ListBox. I am a begginner with vba and some tasks get a bit harder for me at the moment.
there's a multiple choice ListBox with 9 options. If you choose the option "Exfoliación", it executes the macro called "macro4". This is fully customizable, so if I choose from the ListBox the option "Exfoliación" and "Estanqueidad", it will execute the macros 4 and 3 (the ones related to them).
I've seen some example surfinf the Internet, but they're about ListBox's working with columns, sheets, and so on. But there weren't much explanations working with macros.
The user selects the options and presses a Submit button in the worksheet called "Botón". the choices from the Listbox are marked with vector(i)=1. With a for loop the choices are read and executes the corresponding macros to those choices with the array a(i) that contains the names of those macros.
Sub Submit()
'Getting selected items in ListBox1
Dim vector(1 To 11) As Integer
Dim i As Integer
Dim a(1 To 9) As String
'Private Sub CommandButton1_Click()
For i = LBound(a) To UBound(a)
vector(i) = 0
Next i
With Sheets("Botón").ListBox1
Select Case (ListBox1.Text)
Case "Tornillo Resorte": vector(1) = 1
Case "Categoría Manguito": vector(2) = 1
Case "Estanqueidad": vector(3) = 1
Case "Exfoliación": vector(4) = 1
Case "Material vaina": vector(5) = 1
Case "Diseño EC": vector(6) = 1
Case "Curva Q vs Enriquecimiento": vector(7) = 1
Case "Curva Criticidad": vector(8) = 1
Case "Curva de carga t. enfriamiento": vector(9) = 1
Case "Condicioón de transporte": vector(10) = 1
Case "ATI": vector(11) = 1
Case ""
MsgBox "nothing selected"
Case Else
MsgBox Me.ListBox1.Text
End Select
Dim MN As String
For i = 1 To N 'Fill the array
a(i) = "macro" & i
Next
MN = "Módulo5" 'Module where i have the worksheet I'm working with
Dim N As Integer
N = 11
For i = LBound(a) To UBound(a)
If vector(i) = 1 Then
Application.Run MN & "." & a(i)
End If
Next i
End Sub
I find trouble with the Select Case (ListBox1.Text) statement.
It doesn't compile and don't know how to call the listBox with Select Case.
thank you in advance for your help :)
Edit: with a new code. Method with selection:
`Private Sub Command Button1_Click() 'This is a button that opens the multilist with the different options. It works correctly
Worksheets("Botón").ListBox1.Clear
ListBox1.Height=200
ListBox1.Width=250
Dim mylist As Variant
mylist=Array("Tornillo Resorte",...,"Condicioón de transporte")
ListBox1.List=mylist
End Sub
Sub Submit() ''here's the macro with the button assigned to execute the selection. This is where I get the problem.
With Sheets("Botón").ListBox1
MN = "Módulo5" 'Module where i have the worksheet I'm working with
For X = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(X) = True Then
Application.Run MN & "." & .ListIndex + 1
Else
MsgBox "No se ha seleccionado ningún filtro"
End If
Next X
End With
End Sub
If you only wanted to select one macro - and assuming the macros are named sequentially macro1 to macrox, then you can just do this:
Sub Submit()
With Sheets("Botón").ListBox1
if .listindex = -1 then
MsgBox "nothing selected"
Else
MN = "Módulo5" 'Module where i have the worksheet I'm working with
Application.Run MN & "." & .listindex +1
End If
End With
End Sub
If you want to do more than one then you need to loop through the .selected array calling the macros sequentially

How to lock msgbox pop ups in VBA

I'm setting up an office prank for April Fools that when a question is answered wrong a pop up (Msgbox) will pop up and I want it so it doesn't go away. The idea is their screen would get clogged with these msgboxes till they get the questions right. I'm not sure how to accomplish this though. Any help would be greatly appreciated!
Here is the current code:
Sub Button1_Click()
Dim ws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim Ret As Variant
'Lockout Functions
'Cancel = True
'Hal2001 Takes Over
Set ws = ThisWorkbook.Sheets("Hal2001")
Sheets("Hal2001").Visible = True
Sheets("Hal2001").Select
Ret = MsgBox("Would you like to play a game?", vbYesNo)
Application.Speech.Speak "I'm sorry I cannot let you do that, Would you like to play a game?"
If Ret = vbNo Then
Application.Speech.Speak "Well I want to play a game, so we are going to play one"
Else
Application.Speech.Speak "Then Lets Begin"
End If
'First Question
a = Application.InputBox("The Declaration of Independence was signed on what day?")
If a = "July 2nd 1776" Then 'continue
Else
Do While a = Application.InputBox("The declaration of independence was signed on what day?") < 100
Application.Speech.Speak "Are you even trying?"
MsgBox "You really don't know when the Declaration of Independence was signed??"
Loop
End If
'Second Question
b = Application.InputBox("Finish this Sequence 1123_813__")
If b = "1123581321" Then 'Continue
Else
Do While b = Application.InputBox("Finish this Sequence 1123_813__") < 100
Application.Speech.Speak "10, 9, 8, 7, 6, 5, 4, 3, 2, 1!"
MsgBox "Hi, you got that answer wrong"
Loop
End If
'How about some music
Application.Speech.Speak "How about some music?"
Ret = MsgBox("How about some music?", vbYesNo)
If Ret = vbNo Then
Application.Speech.Speak "Too bad, here is one from the eighties you will like."
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
Else
Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url https://www.youtube.com/watch?v=oHg5SJYRHA0")
End If
'Third Question
c = Application.InputBox("What are the next three numbers 1,4,9,16,?")
If c = "1,4,9,16,25,36,49" Then 'continue
Else
Do While c = Application.InputBox("What are the next three numbers 1, 4, 9, 16, ?") < 100
'Application.Speech.Speak "Terrible!"
MsgBox "Hi, you got that answer wrong. Don't you love these pop up boxes?"
Loop
End If
'Unlock/Return Control
Application.Speech.Speak "Congradulations! You survived our April Fools
Joke! Happy April Fools!"
ActiveWindow.SelectedSheets.Visible = False
'Cancel = False
End Sub
This example should help you:
Option Explicit
Public Sub TestQuestion()
Dim StopAfter As Long
StopAfter = 100 'to stop after 100 times asking
Do While Application.InputBox("The Declaration of Independence was signed on what day?") <> "July 2nd 1776" And StopAfter > 0
Application.Speech.Speak "Are you even trying?"
MsgBox "You really don't know when the Declaration of Independence was signed?"
StopAfter = StopAfter - 1
Loop
End Sub
Just to give you an idea how this could be frustrating to someone:
My sheet:
My Macro:
Dim X As Double
Option Explicit
Sub Test()
With ActiveWorkbook.Sheets(1)
For X = 2 To 4
Do While .Cells(X, 4) <> .Cells(X, 3)
.Cells(X, 4) = Application.InputBox(.Cells(X, 2))
Loop
Next X
End With
End Sub
:)

Close the userform automatically after validation is completed

I have created a login screen to authenticate into the excel workbook if a valid password is entered.
code is as below:
Private Sub CommandButton1_Click()
name_selected = ComboBox1.Text
pwd_entered = TextBox2.Text
validation_sheet = "Z"
act_p_col_num = 3
Application.Visible = True
For validation_check = 2 To Worksheets(validation_sheet).Cells(Rows.Count, 1).End(xlUp).Row - 1
If (Worksheets(validation_sheet).Cells(validation_check, 1) = name_selected) Then
bk_pd = Worksheets(validation_sheet).Cells(validation_check, act_p_col_num).Value
If (bk_pd = pwd_entered) Then
Worksheets("INDIVIDUAL_TRACKER").Select
MsgBox ("Authentication successful")
UserForm1.Hide
'Set UserForm1.Visible = False
Else
Application.Visible = False
MsgBox ("Please enter a valid password! Account will be locked after 3 tries")
TextBox2.Text = ""
End If
End If
Next validation_check
End Sub
However this code has been tried using the unload me command and userform1.hide too which is still throwing me a run time error 424,object required.
My objective is to go to the workbook once the authentication passes and the userform should be closed automatically.
Can someone help me in resolving this ?
My guess is that the next iteration of the for loop is what is actually causing the problem. You try to access the TextBox on the if statement when the form has been unloaded.
Try including the line
Exit For
After Unload Me
Reshuffling the application.visible=True lines has solved the purpose. Using it in the right place has made it work well.And a use of Exit For has been an added advantage.
Private Sub CommandButton1_Click()
name_selected = ComboBox1.Text
pwd_entered = TextBox2.Text
validation_sheet = "Z"
act_p_col_num = 3
Application.Visible = True
For validation_check = 2 To Worksheets(validation_sheet).Cells(Rows.Count, 1).End(xlUp).Row - 1
If (Worksheets(validation_sheet).Cells(validation_check, 1) = name_selected) Then
bk_pd = Worksheets(validation_sheet).Cells(validation_check, act_p_col_num).Value
If (bk_pd = pwd_entered) Then
Unload Me
'UserForm1.Hide
'Set UserForm1.Visible = False
Application.Visible = True
Worksheets("INDIVIDUAL_TRACKER").Select
MsgBox ("Authentication successful")
Exit For
Else
'Application.Visible = False
MsgBox ("Please enter a valid password! Account will be locked after 3 tries")
TextBox2.Text = ""
End If
End If
Next validation_check
End Sub
Thanks to everyone who has shed some light on this issue.It was a good brainstorming.Thanks everyone.The issue stands resolved now.

application.inputbox error after clicking OK with empty input

I really searched hours and hours, but I can't find any solutions.
You should only enter numbers into the Inputbox and a msgbox should sppears when you just hit ok without any number or string...
The first part was easy, but I always get an error message by just hitting OK!
Public Sub test()
Dim vntReturn As Variant
vntReturn = Application.InputBox("Bitte Wert eingeben", "Eingabe", , , , , , 1)
If StrPtr(vntReturn) = 0 Then
MsgBox "Abbrechen gedrückt"
Else
If vntReturn = False Then
MsgBox "Nix eingegeben"
Else
MsgBox vntReturn
End If
End If
End Sub
This is happening because you're declaring the Type for this InputBox to a number. So excel will automatically try to correct this. You can use an InputBox without a Type and program your own verification for checking if it's an integer or not.
Otherwise you can also add this before your code:
Application.DisplayAlerts = False
And then set it to True after. Now when you hit ok you won't be prompted with the error, but the InputBox will not go away. You could add additional instructions to the InputBox to make it clear it needs a number.
#mehow: as Alex D just said: Your answers are similar ;-)
First I used the code of mehow, but now I just create a userform with only an "OK-button".
Private Sub Rechnen_Click()
Dim i As Integer ' Variable deklarieren
Dim Sum As Integer
Dim counter As Variant
i = 0 ' deklariert, löst beim Kompilieren keinen Fehler aus
Sum = 0 ' nicht deklarierte Variable löst beim Kompilieren einen Fehler aus
counter = TextBox1.Value
Application.DisplayAlerts = False
If Not IsNumeric(counter) Then
Exit Sub
Else
Unload Userform1
On Error Resume Next
Do Until i >= counter
Zahl = InputBox("Pls enter a number:", i + 1 & ". Versuch")
Sum = Sum + Zahl
i = i + 1
If Not IsNumeric(Zahl) Then
MsgBox "calculation premature cancelled!"
Exit Do
End If
Loop
Ausgabe = MsgBox("Die Summe lautet: " & Sum, vbInformation, "Ergebnis")
Question = MsgBox("is it enough?", vbYesNo + vbQuestion, "repeat")
If Question = vbNo Then
Userform1.Show
Else
Unload Userform1
Exit Sub
End If
End If
End Sub
and so the userform looks like:
Now the program works fine ;) Thank you guys!

Resources