I am using the following code in which if there is data in the parameter - arrRecords then print the data, if there is not data in the parameter arrRecords i.e. arrRecords = "", then skip this step and get out.
If IsEmpty(arrRecords) = True Then
GoTo Get_Out
ElseIf IsEmpty(arrRecords) = Fales Then
PrintArray arrRecords, Y, Lastrecord, 1
End If
Get_Out:
I am also clearing the data in arrRecords after every loop using arrRecords = "". Still in cases where there is data or no data, the code always goes to the statement for Print. Can anyone please help me here.
From a general point of view
If you have something after the Then on the same line you have terminate the If. You will then get a syntax error if you have a following ElseIf.
Use Option Explicit to pick up typos such as Fales.
You don't need = True just If IsEmpty(arrRecords) .
You can default into an Else if not True without a test for False
Do you need to then Exit Sub if False or carry on ?
What is arrRecords? Where is it coming from?
Code:
Option Explicit
Sub test()
If IsEmpty(arrRecords) Then '<> vbNullString ''if string
GoTo Get_Out
Else
PrintArray arrRecords, Y, Lastrecord, 1
'Exit Sub '<== What happens here? Otherwise you still hit Get_Out
End If
Get_Out:
End Sub
Related
I have a workbook with userforms to write to several numeric and date fields. I need to validate the textbox control for proper numbers and dates.
Rather than replicate the validation for each textbox, I thought I would call a common subprocedure within the BeforeUpdae event of each textbox.
I have two problems.
If I execute the form and test using text in tbAmount box, it seems the ContolValidate procedure is not called.
If I run it in break mode with a breakpoint on Call ContolValidate(What, CurrentControl), it will step through that procedure.
Even though it steps through the procedure, the Cancel = True does not seem to work.
If I paste the ContolValidate code directly in the BeforeUpdate, the Cancel = True does work.
This code is all on the userform.
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim What As String
Dim CurrentControl As Control
What = "NumericField"
Set CurrentControl = Me.ActiveControl
Call ContolValidate(What, CurrentControl)
End Sub
Private Sub ContolValidate(What, CurrentControl)
If Not IsNumeric(CurrentControl.Value) Then
ErrorLabel.Caption = "Please correct this entry to be numeric."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
Else
If CurrentControl.Value < 0 Then
ErrorLabel.Caption = "This number cannot be negative."
Cancel = True
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End If
End Sub
Private Sub tbAmount1_AfterUpdate()
ErrorLabel.Visible = False
tbAmount1.BackColor = Me.BackColor
End Sub
(1) When your control is named tbAmount1 and the code is in the code-behind module of the form, the trigger should fire.
(2) As #shahkalpesh mentioned in his comment, Cancel is not known in your validate-routine. Putting Option Explicit at the top of you code would show you that.
I would suggest to convert the routine to a function. In the code below, I return True if the content is okay and False if not (so you need to put a Not to the result to set the Cancel-parameter)
Private Sub tbAmount1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Not ControlValidate("NumericField", Me.ActiveControl)
End Sub
Private Function ControlValidate(What, CurrentControl) As Boolean
ControlValidate = False
If Not IsNumeric(CurrentControl.Value) Then
errorlabel.Caption = "Please correct this entry to be numeric."
ElseIf CurrentControl.Value < 0 Then
errorlabel.Caption = "This number cannot be negative."
Else
ControlValidate = True ' Input is okay.
End If
If ControlValidate Then
CurrentControl.BackColor = vbWhite
Else
CurrentControl.BackColor = rgbPink
CurrentControl.SelStart = 0
CurrentControl.SelLength = Len(CurrentControl.Value)
End If
End Function
P.S.: I changed the name to ControlValidate - "contol" seems wrong to me...
I am trying to create a macro that copies a line from a table into another table if it fits into the date conditions you give through two date-boxes.
I am struggling with the part where I would need to mix a "For i" If function.
It doesn't seem to work but I can't figure out how to build the macro otherwise.
I get the error:
"next without for"
when I try to start it.
edit1: I added the missing "End If" - line
When I use "End If" after the first If cycle it tells me "Compilation error - End if used without If Block"
When I use it only after the second if-cycle I get "runtime error 9 - index out of valid range"
I have never needed to use "End If" before.
I added "Sheets("TestArray").Select" to the second If Cycle so it jumps back to the original worksheet but that didn't fix the runtime error.
Public Sub ContractDate()
Dim sh As Worksheet
Dim ContractNumber(1 To 100) As String
Dim ContractStatus(1 To 100) As String
Dim i As Integer
Dim ContractDate(1 To 100) As Date
Set sh = ThisWorkbook.Worksheets("Test Array")
Range("G3:G103").ClearContents
For i = 1 To 100
ContractNumber(i) = sh.Range("F3").Offset(i).Value
Next i
For i = 1 To 100
ContractDate(i) = sh.Range("B3").Offset(i).Value
Next i
For i = LBound(ContractDate) To UBound(ContractDate)
If ContractDate(i) > DTPicker21.Value And ContractDate(i) < DTPicker22.Value Then sh.Range("F3").Offset(i) = "YES"
'End If
Next i
For i = LBound(ContractDate) To UBound(ContractDate)
If sh.Range("F3").Offset(i).Value = "YES" Then
Sheets("Test Array").Range("A3:E3").Offset(i).Copy
Sheets("ResultArray").Select
Range("A3:E3").Offset(i).Select
ActiveSheet.Paste
Sheets("TestArray").Select
End If
Next i
End Sub
You are missing the end if before the last next i
I've got an UserForm, which upon an incorrect user input calls the following procedure, which highlights the field and disables the "save changes" button.
Private disabledElems As New Collection
Private Sub disable(ByRef controlName As String)
UserForm1.Controls(controlName).BackColor = &H8080FF
Me.save_button.Enabled = False
Dim i As Byte
If disabledElems.Count <> 0 Then
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
Exit Sub ' we dont want to add duplicates to collection
End If
Next i
End If
disabledElems.Add controlName ' otherwise add to collection
End Sub
If the input is corrected, it calls the enable procedure, which looks like this:
Private Sub enable(ByRef controlName As String)
Me.Controls(controlName).BackColor = &H80000005
Dim i As Byte
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
disabledElems.Remove i ' remove the enabled element upon match
End If
Next i
If disabledElems.Count = 0 Then
save_button.Enabled = True
End If
End Sub
This seems to work just fine when I try this with one Textbox
However, as soon I have multiple incorrect entries, my enable procedure seems to throw a Subscript out of range error seemingly for no reason.
The highlighted line in the debugger is:
If disabledElems(i) = controlName Then
I can't comprehend what could be causing this. Any ideas?
Ah alright, it's one of those classical "when removing a row, loop
from end to beginning"
Basically, the reason why the Subscript out of range was thrown - once the element was removed from the collection via the
disabledElems.Remove i
It reduced the size of the Collection from Collection.Count to Collection.Count - 1, however during the for loop declaration, the i was already hard-set to the previous Collection.Count
In an practical example:
Let's say my Collection looks like this
disabledElems = "button1", "button2"
Upon doing this
controlName = "button1"
For i = 1 to disabledElems.Count ' <= 2
If disabledElems(i) = controlName ' < True for i = 1
disabledElems.Remove i ' < button1 was removed from collection, however it still loops
End If
' will loop to i = 2. However disabledElems(2) no longer exists, because upon removal _
the button2 was shifted to disabledElems(1) - hence Subscript out of range
Next i
A clear case of trying to access an element, which has shifted its position in the queue.
There are two possible fixes (that I can think of):
1. Enforce Exit Sub upon removal
For i = 1 to disabledElems.Count
If disabledElems(i) = controlName
disabledElems.Remove i
Exit Sub
End If
Next i
2. Loop from end to start
Dim i as Integer ' needs to be redeclared to int, because Byte can't -1
For i = disabledElems.Count to 1 Step -1
If disabledElems(i) = controlName
disabledElems.Remove i
End If
Next i
I am having trouble running a VLookup inside a Change Event sub. I have tested all other lines of code and made sure they work, so it's only the VLookup that's not working.
For brief background, I have two sheets. Sheet1 contains the ID (where it could have multiple IDs on separate line, hence the SPLIT function used below), Sheet 2 contains the ID and its Description. What I wanted to do is perform a VLookup upon value change and insert description for each ID as comment into the cell.
The line that is not working for me is: Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False).
I'm not getting any errors but it jumps right to exitHandler without running the reminder of the logic. I'm certain that the ID exists in the table for the VLookup. If someone can help me point out why it is not working, I will be very appreciated!
Below is a snippet of the code where VLookup is used:
With Target
If .Comment Is Nothing Then
'do nothing
Else
.Comment.Delete
End If
If Target.Value = "" Then
.Comment.Delete
Else
If InStr(Target.Value, vbCrLf) = 0 Then
IDs = Split(Target.Value)
Else
IDs = Split(Target.Value, vbCrLf)
End If
For i = LBound(IDs) To UBound(IDs)
If commentText = "" Then
'Add description for ID as comment
commentText = Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
Else
'Keep on adding description for each ID as comment
commentText = commentText & vbCrLf & Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
End If
Next
.AddComment Text:=commentText
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
exitHandler:
Application.EnableEvents = True
End Sub
As the part of the varible defintions is missing, i would guess that commentText is defined as String. If Vlookup performs a search without a match it will return an error, so the variable has to be defined as Variant otherwise you will get a type mismatch. You wont see the error when you use an On Error Goto-Statement. Also then you should check after a Vlookup if no error occured, i.e with the IsError-Function.
Thank you so much for your replies. Indeed, it should be Application.VLookup and not Application.WorksheetFunction.VLookup. I also had to convert IDs(I) to CLng to prevent 2042 error. Changing commentText to Variant is also needed to see the error code.
In the end, this is what worked for me:
Application.VLookup(CLng(IDs(i)), Sheet2.Range("A3:B30"), 2, False)
Thanks again for all the help!
I'm trying to write a UDF that returns whether the cell is at a page break.
So far I have this:
Function pbreak() As Boolean
' Application.Volatile
pbreak = False
Dim ra As Range
Set ra = Application.Caller
With ra
For i = 1 To .Worksheet.HPageBreaks.Count
If .Worksheet.HPageBreaks(i).Location.Row = .Row Then
pbreak = True
End If
Next
End With
End Function
This returns a #VALUE error. I've tried debugging it, HPageBreaks.Count returns 3 (and there are 3 page breaks), but HPageBreaks(i) yields an "index out of range"-error for all pagebreaks that are below the current cell .
Is this a bug (ie .Count is wrong), or is there some special behavior with page breaks that I am missing?
Is there a way to fix this (preferably without resorting to on error resume next)?
Thanks
Martin
Option Explicit
Function pbreak() As Boolean
' Application.Volatile
Dim i As Integer 'the missing line
pbreak = False
Dim ra As Range
Set ra = Application.Caller
With ra
For i = 1 To .Worksheet.HPageBreaks.Count
If .Worksheet.HPageBreaks(i).Location.Row <= .Row Then
If .Worksheet.HPageBreaks(i).Location.Row = .Row Then
pbreak = True
'exit the function once a page break is found.
Exit Function
End If
Else
Exit Function
End If
Next
End With
End Function
EDIT: Always use Option Explicit & compile the code before using it.
Use of Exit Function inside the loop is to prevent the code from running it further, once the result is known.