I have an excel udf as one of the columns of a listobj (excel table). When I refresh the table I get mixed results on whether the udf calculates or not. Some of the cells recaculate some return #value. If I select a #value cell and click in the formula bar and click the 'check' it evaluates correctly. Or if I copy it down the column it calculates correctly.
I've added a worksheet change event to .calculate the listobj.
Any advise is appreciated.
Here's my user defined function.
Function colorscore(dest, score)
Dim scr
scr = score
Select Case scr
Case Is = 99
srcred = 255
srcgreen = 0
srcblue = 0
Case Is > 0
srcred = (1 - scr) * 255
srcgreen = 255 - ((255 - 176) * scr)
srcblue = scr * 80
Case Else
srcred = 255
srcgreen = 255
srcblue = 255
End Select
dest.Parent.Evaluate "ChangeIt2(" & dest.Address(False, False) & "," _
& srcred & "," _
& srcgreen & "," _
& srcblue & "" _
& ")"
colorscore = "Changed sheet!" 'or whatever return value is useful...
End Function
Sub ChangeIt2(c1 As Range, c2red, c2green, c2blue)
c1.Interior.Color = RGB(c2red, c2green, c2blue)
End Sub
here's the worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.ListObject Is Nothing Then Exit Sub
ActiveSheet.EnableCalculation = False
ActiveSheet.EnableCalculation = True
End Sub
looks like you have 2 definitions of score: one is a parameter to the udf and the other is a defined named score.
Then you evaluate the defined name using [score] notation.
So Excel does not know that there is a dependency on defined name score and so the UDF does not recalc when you change defined name score
Related
I have this Sub. It is activated when pressing a button on a user form and is used to count one entry up. I have the total amount of entries in this data base stored in A1. There is another button used to count one entry down, it works just fine. They both have checks so they don't load entries that don't exist. Somehow this one doesn't work.
Private Sub ButtonRight_Click()
MsgBox TextBoxID.Value
MsgBox Cells(1, 1).Value
MsgBox (TextBoxID.Value < Cells(1, 1).Value)
If TextBoxID.Value < Cells(1, 1).Value Then
LoadEntry (TextBoxID.Value + 1)
End If
End Sub
The LoadEntry Sub is used in other places as well and it works. I have this output stuff with MsgBox for debugging. It gives the outputs 1, 2, false. So (1 < 2) = false.
For comparison here is the other one which works:
Private Sub ButtonLeft_Click()
If TextBoxID.Value > 1 Then
LoadEntry (TextBoxID.Value - 1)
End If
End Sub
The problem is implicit conversions.
Strings are compared as text, so "10" is smaller than "2" because it sorts alphabetically as such.
Debug.Print "10" > "2" ' output: False
The value of a TextBox control is always a String; in order to treat it as a numeric value you must first convert it to a numeric value - but only if it's legal to do so (e.g. "ABC" has no equivalent numeric value).
Moreover, a cell's value is a Variant that may contain a number or another value that can (will) correctly but implicitly convert to a numeric value, but it could also be a Variant/Error (e.g. #N/A, or #VALUE! errors) that will throw a type mismatch error every time you try to compare it to anything (other than another Variant/Error value), so the cell's value should also be validated and explicitly converted before it's compared:
Dim rawValue As String
rawValue = TextBoxID.Value
If IsNumeric(rawValue) Then
Dim numValue As Double
numValue = CDbl(rawValue)
Dim cellValue As Variant
cellValue = ActiveSheet.Cells(1, 1).Value
If IsNumeric(cellValue) Then
If numValue < CDbl(cellValue) Then
LoadEntry numValue + 1
End If
End If
End If
Note that unqualified, Cells is implicitly referring to whatever the ActiveSheet happens to be - if that isn't the intent, consider qualifying that member call with an explicit Worksheet object, e.g. Sheet1.Cells(1, 1). If it is intentional, consider qualifying it with ActiveSheet so that the code says what it does, and does what it says.
Comparing values of different types in VBA is not a simple task, the result of the comparison depends on the types of variables, the possibility of conversion to a number, etc. Variant variables are compared differently than "non-Variant" variables. See https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/comparison-operators
According to the documentation, the Value property of the TextBox object has a base type Variant (see https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/value-property-microsoft-forms).
Therefore, the result of comparing Variant/String (TextBox.Value with String) and Variant/Double (Cell.Value with number) - TextBox.Value is always larger than Cell.Value:
Private Sub CommandButton1_Click()
TextBox1.Value = "123"
[A1].Value = 9999
Debug.Print "TextBox1.Value = " & TextBox1.Value & ", Type is " & TypeName(TextBox1.Value)
Debug.Print "[A1].Value = " & [A1].Value & ", Type is "; TypeName([A1].Value)
Debug.Print "TextBox1.Value > [A1].Value : (" & TextBox1.Value & " > " & [A1].Value & ") is " & (TextBox1.Value > [A1].Value)
Me.Hide
End Sub
'Output:
'TextBox1.Value = 123, Type is String
'[A1].Value = 9999, Type is Double
'TextBox1.Value > [A1].Value : (123 > 9999) is True
Therefore, it is advisable before comparing:
reduce the types of compared values to one;
to handle errors of type conversion
Simple way is to use Val() function https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/val-function
Private Sub ButtonRight_Click()
If Val(TextBoxID.Value) < Val(Cells(1, 1).Value) Then
LoadEntry (TextBoxID.Value + 1)
End If
End Sub
Also for this purpose I propose to create a function:
Function getNumDef(v As Variant, Optional defV As Long = -1) As Long
getNumDef = defV 'inintially getNumDef set as defaul value
On Error Resume Next
getNumDef = CLng(v) ' if error occurs, getNumDef value remains defV
End Function
It can be applied in the following way:
Private Sub ButtonRight_Click()
Dim TBV as Long, CV as Long
TBV = getNumDef(TextBoxID.Value) 'Type conversion and error handling
CV = getNumDef(Cells(1, 1).Value) 'Type conversion and error handling
If TBV < 0 Or CV < 0 Then
MsgBox "Some of the values are not numeric or less than 0" _
& vbCrLf & "Check the raw data", vbCritical + vbOKOnly, "Sub ButtonRight_Click()"
Else
If TBV < CV Then
'The parentheses in `LoadEntry (TextBoxID.Value + 1)` are syntax sugar,
' i.e. the argument `TextBoxID.Value + 1` in parentheses is passed as ByVal.
'If the argument without (), i.e. `LoadEntry TextBoxID.Value + 1`,
'it is passed as described in the Sub definition or the default ByRef
LoadEntry TextBoxID.Value + 1
End If
End If
End Sub
The main VBA procedure counts characters in table cells in a Word document. Since it can count characters different ways:
Count the "Objective" text for the selected table
Count the "Accomplishment" text for the selected table
Count both the Obj and Acc texts in each table (loop), for all tables (another loop)
I created calling procedures for each option above that calls the main procedure. This way I pass variables from the calling Sub to the main Sub. These variables (1) tell the main Sub whether I want to count what is in row 3 (objective) or in row 5 (accomplishment) or both, and (2) feed the If/then lines in the main Sub to make sure the right row is counted. At the time, it seemed elegant, in hindsight - not so much.
Word template below:
There will be text in O1 and the VBA will count it (characters, spaces + paragraphs) and output it in C1, and the C1 fill changes red or green if over/under the character limit. The same for A1 and C2 and so on for any number of following tables.
PROBLEM DESCRIPTION
The VBA was working for the actions above when I had the row/columns hard coded into various places in the code. If rows/columns were ever added/deleted from the tables, they would have to updated in multiple spots. It would be simpler if the row/column numbers were in one place and referred back to as variables, so I changed the row/col #s to public variables. Then the problem began.
In the code, I track (debug.print) what becomes of oRow (output row) & chcct (character count col) and both are 0 as the main Sub runs, despite both being initialized as 3 in the public Sub Row_Col_Num() below.
My public variables are at the top of the module before the first Sub() and denoted as Public. Sub Row_Col_Num() which contains the variable assignments is also Public. All Subs are in the same standard module.
Option Explicit
Public oRow As Integer 'row with "Objectives" text
Public aRow As Integer 'row with "Accomplishments" text
Public cOnA As Integer 'column that both obj and accmp text are in
Public cChCt As Integer 'column that the char count is output to
Public Sub Row_Col_Num()
oRow = 3
aRow = 5
cOnA = 1
cChCt = 3
Debug.Print "cchct pub sub: " & cChCt
End Sub
ATTEMPTS TO FIX PROBLEM & RESULTS
I used the variable normally and left it Public as well as the Sub that assigns the variables (oRow =3) values.
Sub TableCharCount_Obj()
'Run character count for the "Objectives" in the SELECTED table
Debug.Print "orow = " & oRow
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
I tried putting the Sub() name in front of the variable when it is used, e.g. Row_Col_Num.orow, in the Sub above.
Call TableCharCount(Row_Col_Num.oRow, Row_Col_Num.oRow)
I tried the module name in front of the variable as well, e.g. Module1.orow.
Call TableCharCount(Module1.oRow, Module1.oRow)
RESULTS
#1 & #3 resulted in the macro counting the wrong row and outputting to the wrong cell.
#2 resulted in error "Expected Function or variable" at line: Call TableCharCount(Row_Col_Num.oRow, Row_Col_Num.oRow)
All 3 cases orow and cchct both continued to be 0 throughout the run.
QUESTIONS / SOLUTIONS
a) Can a Public variable (oRow) be used as an argument passed from calling Sub to called Sub as ByVal a As Integer?
b) Does Public Sub Row_Col_Num(), which assigns values to the public variables, have to be explicitly run or called to populate the variables in the other Subs w/ the correct values?
c) Should I call Public Sub Row_Col_Num() in every calling Sub before calling the main Sub?
Sub TableCharCount_Obj()
Call Public Sub Row_Col_Num() '<<< add this call
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
This option seems like a bad design.
If it's not obvious, there was some mission creep as I added more capability For now, if I could get the public variables to work, it would be done. Appreciate any suggestion to get these variables to work. For the purposes of this question, I only left the code for the variable Sub, the first calling Sub and the main Sub. VBA below:
'#0 -- This creates variables for column and row number used in all the macros. Only need to change row/col number here if row/col are added/deleted
Option Explicit
Public oRow As Integer 'row with "Objectives" text
Public aRow As Integer 'row with "Accomplishments" text
Public cOnA As Integer 'column that both obj and accmp text are in
Public cChCt As Integer 'column that the char count is output to
'This assigns row/column numbers to the variables
Public Sub Row_Col_Num()
oRow = 3
aRow = 5
cOnA = 1
cChCt = 3
Debug.Print "cchct pub sub: " & cChCt End Sub
'#2
Sub TableCharCount_Obj() 'Run character count for the "Objectives" in the SELECTED table
Debug.Print "orow = " & oRow
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
'other calling procedures removed
'#5
Option Explicit
Sub TableCharCount(ByVal a As Integer, ByVal b As Integer)
'Counts total characters in a cell w/in a table and outputs the number to a different cell, and colors the cell red or green if over/under the maximum number of characters.
Dim charCount, charWSCount, paraCount, charTot As Double
Dim iRng, oRng, txtRng As Word.Range
Dim i, max, s, t, x As Integer
Dim tcount, tbl As Integer
Dim DocT As Table 'for active doc tables
Debug.Print "cchct1= " & cChCt 'Debug.Print vbCr & "-----START-------" & vbCr Application.ScreenUpdating = False
If a <> b Then
tcount = ActiveDocument.Tables.Count
tbl = 1 'used in FOR loop, start w/ table #1
s = b - a '"STEP" used in FOR loop = # of rows between objectives text and accomplishments text Else
On Error GoTo ErrMsg 'handles expected user error of not selecting a table to execute on
tbl = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count 'ID the table that is selected
tcount = tbl 'prevents FOR loop from trying to run again
s = 1 '"STEP" used in FOR loop = # of rows between objectives text and accomplishments text / do not set to zero = infinite loop End If
'Debug.Print "# of Tables: " & tcount
For t = tbl To tcount 'loops thru the tables
Set DocT = ActiveDocument.Tables(t)
For x = a To b Step s 'loops thru the applicable row(s) in the table
'Debug.Print "x # start = " & x
'Debug.Print "table " & t
iRng = DocT.Cell(x, cOnA)
iRng.Select
'Count used in output
Selection.MoveLeft wdCharacter, 1, wdExtend 'computerstats requires the text itself selected, characters.count can use the whole cell selected
charWSCount = Selection.Range.ComputeStatistics(Statistic:=wdStatisticCharactersWithSpaces) 'counts bullets & space after bullet / not line breaks (paragraphs)
'Debug.Print "Comp statchar# " & charWSCount
'---------
paraCount = Selection.Range.ComputeStatistics(Statistic:=wdStatisticParagraphs)
'Debug.Print "#paras = " & paraCount
'----------
charTot = charWSCount + paraCount
'Output to table cell
i = x - 1 'output cell is 1 row above cell that is counted
Set oRng = DocT.Cell(i, cChCt).Range 'Char count ouput row,column
Debug.Print "cchct2= " & cChCt
oRng.Text = charTot
Set txtRng = DocT.Cell(i, cChCt - 1).Range '"# Char:" location row,column
txtRng.Text = "# Char:"
'Maximum # of char allowed in a cell. Used to change cell fill red or green.
max = 2000 '"Accomplishment" row (row 5) has a max of 2000
If i = 2 Then max = 1500 '"Objective" row (row 3) has a max of 1500
'Change color of cell to indicate over/under max # of characters
If charCount < max Then
oRng.Shading.BackgroundPatternColor = wdColorBrightGreen
Else: oRng.Shading.BackgroundPatternColor = wdColorRed
End If
'Debug.Print "x # end = " & x
'Debug.Print "--------Next x--------------"
Next x
'Debug.Print "------Next Table------"
Next t
ActiveDocument.Tables(tbl).Select 'attempt to move to top of 1st table if using CharCount_AllTab() or just to the top of the selected table for the other macros
Selection.GoTo What:=wdGoToBookmark, Name:="\Page" Selection.StartOf
Application.ScreenUpdating = True
Exit Sub
ErrMsg: Msgbox "Select a table by placing the cursor anywhere in the table. Press OK and try the macro again numnuts!", _
vbOKOnly, "Table not selected"
End Sub
I have done some research and haven't found any similar question.
I have a VBA macro that imports a .CSV file containing telegrams sent by a device.
In the end of this macro, I want to create a graph with the time elapsed on the x-axis and the value corresponding to the telegram.
The issue is that this value can be of different types: hexadecimal, boolean, integer... And that they don't respect the standard Excel number format, which means that they can't be used to create a graph.
Here are some examples (with " around the value to show its start and end) :
hexadecimal : "A7 C8"
Boolean : "$00" or ""$01"
Percentage : "$30"
And here is an example of data, with custom time format and boolean value
Here is my related code so far, where I try to convert into a custom type then convert back to numeric to get a common number datatype :
If wsRes.Range("R1").Value Like "$##" Then
wsRes.Range("R1:R" & plotLine).NumberFormat = "$##"
wsRes.Range("R1:R" & plotLine).NumberFormat = General
End If
If wsRes.Range("R1").Value Like "??[ ]??" Then
Dim valArray(1) As String
For i = 1 To plotLine Step 1
valArray = Split(wsRes.Range("R" & i), " ")
wsRes.Range("R" & i).Value = ToInt32(valArray(0) + valArray(1), 16)
wsRes.Range("" & i).NumberFormat = General
Next i
End If
I haven't been able to test it with hexa yet, but the conversion trick doesn't work with percentage/boolean
EDIT :
First, thank you for your answers.
Here is my final code for anyone's interested, adapted from Vityata's.
This method will allow to easily add other datatypes if needed.
Sub TestMe()
Dim RangeData as String
Set wsRes = ActiveWorkbook.Sheets("Results")
For i = 1 To plotLine Step 1 'plotLine is the last line on which I have data
DetectType wsRes.Range("R" & i).Value, i
Next i
RangeData = "Q1:R" & plotLine
CreateGraph RangeData 'Call My sub creating the graph
End Sub
Public Sub DetectType(str As String, i As Integer)
Select Case True
Case wsRes.Range("R" & i).Value Like "??[ ]??"
wsRes.Range("R" & i).Value = HexValue(str)
Case wsRes.Range("R" & i).Value Like "?##"
wsRes.Range("R" & i).Value = DecValue(str)
Case Else
MsgBox "Unsupported datatype detected : " & str
End
End Select
End Sub
Public Function HexValue(str As String) As Long
Dim valArray(1) As String 'Needed as I have a space in the middle that prevents direct conversion
valArray(0) = Split(str, " ")(0)
valArray(1) = Split(str, " ")(1)
HexValue = CLng("&H" & valArray(0) + valArray(1))
End Function
Public Function DecValue(str As String) As Long
DecValue = Right(str, 2)
End Function
You need three boolean functions, following your business logic and some of the Clean Code principles (although the author of the book does not recognize VBA people as programmers):
IsHex()
IsBoolean()
IsPercentage()
Public Sub TestMe()
Dim myInput As Variant
myInput = Array("A7C8", "$01", "$30")
Dim i As Long
For i = LBound(myInput) To UBound(myInput)
Debug.Print IsHex(myInput(i))
Debug.Print IsBoolean(myInput(i))
Debug.Print IsPercentage(myInput(i))
Debug.Print "-------------"
Next i
'or use this with the DetectType() function below:
'For i = LBound(myInput) To UBound(myInput)
' Debug.Print DetectType(myInput(i))
'Next i
End Sub
Public Function IsHex(ByVal str As String) As Boolean
On Error GoTo IsHex_Error
IsHex = (WorksheetFunction.Hex2Dec(str) <> vbNullString)
On Error GoTo 0
Exit Function
IsHex_Error:
End Function
Public Function IsBoolean(ByVal str As String) As Boolean
IsBoolean = CBool((str = "$00") Or (str = "$01"))
End Function
Public Function IsPercentage(ByVal str As String) As Boolean
IsPercentage = (Len(str) = 3 And Left(str, 1) = "$" And IsNumeric(Right(str, 2)))
End Function
Then some additional logic is needed, because $01 is both Boolean and Percentage. In this case, you can consider it Percentage. This is some kind of a mapper, following this business logic:
Public Function DetectType(str) As String
Select Case True
Case IsHex(str)
DetectType = "HEX!"
Case IsPercentage(str) And IsBoolean(str)
DetectType = "Boolean!"
Case IsPercentage(str)
DetectType = "Percentage!"
Case Else
DetectType = "ELSE!"
End Select
End Function
I need to validate user input on when cells change and show the error in another cell in Excel using VBA.
I run into problems where my validator is called on all cells in the sheet when a user inserts rows or column which makes Excel unresponsive for a long time, how can I fix this?
Below are my requirements and my current solution with full documentation.
Definition and requirements
Consider the following table:
Example User Input Table
| | | Tolerance | | |
| Type | Length | enabled | Tolerance | Note |
|------|--------|-----------|-----------|----------------------------|
| | 4 | 0 | | Type is missing |
| | | 0 | | Type is missing |
| C | 40 | 1 | 110 | |
| D | 50 | 1 | | Tolerance is missing |
| | | | | |
The idea is that the user inputs values in the table, once a value has been changed (the user leaves the cell) the value is validated and if there is a problem the error is printed in the Note column.
Blank lines should be ignored.
I need this to be robust meaning it should not fail on any user input, that means it has to work for the following cases:
Paste values
Delete rows
Insert rows (empty or cut cells)
Insert/delete columns *
Any other case I missed thinking about?
*It is OK if the the validation fails when a user is deleting a column that is part of the table as this is seen as the user willfully vandalizing the sheet, but it has to fail gracefully (i.e. not by validating all cells in the worksheet which takes a long time). It would have been great if this action was undoable, however my current understanding of Excel suggests this is impossible (after a macro has changed something in the sheet, nothing can be undone anymore).
The Note cell can only contain one error at a time, for the user the most relevant error is the one for the cell the user last changed, so it should display this error first. After the user fixes that error the order is not that important anymore, so it could just display the errors from left to right.
Problems with current approach
My problem is that when rows/columns are inserted validation is triggered for all cells in the sheet which is a very slow process and to the user it looks like the program has crashed, but it will return once the validation is complete.
I don't know why Excel does this but I need a way to work around it.
Code placed in a Sheet named 'User Input'
My solution is based on the only on change event handler I know of: the per sheet global Worksheet_Change function (ugh!).
Worksheet_Change function
First it checks if the changed cell(s) intersects with the cells I'm interested in validating. This check is actually quite fast.
OldRowCount here is a try to catch the user inserting or deleting cells depending on how the used range changes, however this only solves some cases and introduces problems whenever Excel forgets the global variable (which happens now and then for as to me unknown reasons) as well as the first time the function is run.
The for loop makes it work for pasted values.
Option Explicit
Public OldRowCount As Long
' Run every time something is changed in the User Input sheet, it then filters on actions in the table
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRowCount As Long
NewRowCount = ActiveSheet.UsedRange.Rows.count
If OldRowCount = NewRowCount Then
If Not Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) Is Nothing Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed, for example while pasting cells
For Each myCell In Target.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
ElseIf OldRowCount > NewRowCount Then
'Row deleted, won't have to deal with this as it solves itself
OldRowCount = NewRowCount
ElseIf OldRowCount < NewRowCount Then
Debug.Print "Row added, TODO: deal with this"
OldRowCount = NewRowCount
End If
End Sub
Code placed in a module
Global variables
Defines the rows/columns to be validated.
Option Explicit
' User input sheet set up
Public Const ROW_FIRST = 8
Public Const COL_TYPE = "B"
Public Const COL_LENGTH = "C"
Public Const COL_TOLERANCE_ENABLED = "D"
Public Const COL_TOLERANCE = "E"
Public Const COL_NOTE = "G"
Cell checking function
This function validates the given cell unless the row where the cell is is empty.
Meaning we are only interested in validating cells on rows where the user has actually started giving values. Blank rows is not a problem.
It first validates the currently changed cell, if it is OK it will then validate the other cells on the given row (since some cells validation depends the values of other cells, see Tolerance enabled in my example table above).
The note will only ever contain one error message at a time, the above is done so that we always get the error of the last changed cell in the Note cell.
Yes, this will make the checker run twice on the current cell, while it is not a problem it could be avoided by a more complex if statement, but for simplicity I skipped it.
Sub checkInput_cell(thisRow As Long, thisCol As Long, sheet As Worksheet)
Dim note As String
note = ""
With sheet
' Ignore blank lines
If .Range(COL_TYPE & thisRow).value <> "" _
Or .Range(COL_LENGTH & thisRow).value <> "" _
Or .Range(COL_TOLERANCE_ENABLED & thisRow).value <> "" _
Or .Range(COL_TOLERANCE & thisRow).value <> "" _
Then
' First check the column the user changed
If col2Let(thisCol) = COL_TYPE Then
note = check_type(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_LENGTH Then
note = check_length(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE_ENABLED Then
note = check_tolerance_enabled(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE Then
note = check_tolerance(thisRow, sheet)
End If
' If that did not result in an error, check the others
If note = "" Then note = check_type(thisRow, sheet)
If note = "" Then note = check_length(thisRow, sheet)
If note = "" Then note = check_tolerance_enabled(thisRow, sheet)
If note = "" Then note = check_tolerance(thisRow, sheet)
End If
' Set note string (done outside the if blank lines checker so that it will reset the note to nothing on blank lines)
' only change it actually set it if it has changed (optimization)
If Not .Range(COL_NOTE & thisRow).value = note Then
.Range(COL_NOTE & thisRow).value = note
End If
End With
End Sub
Validators for individual columns
These functions takes a row and validate the a certain column according to it's special requirements. Returns a string if the validation fails.
' Makes sure that type is :
' Unique in its column
' Not empty
Function check_type(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
Dim duplicate_found As Boolean
Dim lastRow As Long
Dim i As Long
duplicate_found = False
value = sheet.Range(COL_TYPE & affectedRow).value
check_type = ""
' Empty value check
If value = "" Then
check_type = "Type is missing"
Else
' Check for uniqueness
lastRow = sheet.Range(COL_TYPE & sheet.Rows.count).End(xlUp).row
If lastRow > ROW_FIRST Then
For i = ROW_FIRST To lastRow
If Not i = affectedRow And sheet.Range(COL_TYPE & i).value = value Then
duplicate_found = True
End If
Next
End If
If duplicate_found Then
check_type = "Type has to be unique"
Else
' OK
End If
End If
End Function
' Makes sure that length is a whole number larger than -1
Function check_length(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_LENGTH & affectedRow).value
check_length = ""
If value = "" Then
check_length = "Length is missing"
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_length = "Length cannot be decimal"
ElseIf value < 0 Then
check_length = "Length is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_length = "Length contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_length = "Length is not a number"
End If
End Function
' Makes sure that tolerance enabled is either 1 or 0:
Function check_tolerance_enabled(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value
check_tolerance_enabled = ""
If Not value = "0" And Not value = "1" Then
check_tolerance_enabled = "Tolerance enabled has to be 1 or 0"
Else
' OK
End If
End Function
' Makes sure that tolerance is a whole number larger than -1
' But only checks tolerance if it is enabled in the tolerance enabled column
Function check_tolerance(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE & affectedRow).value
check_tolerance = ""
If value = "" Then
If sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value = 1 Then
check_tolerance = "Tolerance is missing"
End If
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_tolerance = "Tolerance cannot be decimal"
ElseIf value < 0 Then
check_tolerance = "Tolerance is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_tolerance = "Tolerance contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_tolerance = "Tolerance is not a number"
End If
End Function
Addressing support functions
These functions translates a letter to a column and vice versa.
Function let2Col(colStr As String) As Long
let2Col = Range(colStr & 1).Column
End Function
Function col2Let(iCol As Long) As String
Dim iAlpha As Long
Dim iRemainder As Long
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
col2Let = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
col2Let = col2Let & Chr(iRemainder + 64)
End If
End Function
Code is tested on/has to work for Excel 2010 and onwards.
Edited for clarity
Finally got it working
After quite a bit of more agonizing, it turned out the fix was quite easy.
I added a new test that checks if the area that the user changed (the Target Range) consists of a column by looking at the address of the Range, if it is a full column the checker will ignore it. This solves the problem where the validation hogs Excel for about one minute.
The result of the intersection calculation is used for the inner loop which limits checks to cells within the area we are interested in validating.
Fixed Worksheet_Change function
Option Explicit
' Run every time something is changed in the User Input sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim InterestingRange As Range
Set InterestingRange = Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE))
If Not InterestingRange Is Nothing Then
' Guard against validating every cell in an inserted column
If Not RangeAddressRepresentsColumn(InterestingRange.address) Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed,
' for example when pasting cells
For Each myCell In InterestingRange.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
End If
End Sub
New support function
' Takes an address string as input and determines if it represents a full column
' A full column is on the form $A:$A for single or $A:$C for multiple columns
' The unique characteristic of a column address is that it has always two
' dollar signs and one colon
Public Function RangeAddressRepresentsColumn(address As String) As Integer
Dim dollarSignCount As Integer
Dim hasColon As Boolean
Dim Counter As Integer
hasColon = False
dollarSignCount = 0
' Loop through each character in the string
For Counter = 1 To Len(address)
If Mid(address, Counter, 1) = "$" Then
dollarSignCount = dollarSignCount + 1
ElseIf Mid(address, Counter, 1) = ":" Then
hasColon = True
End If
Next
If hasColon And dollarSignCount = 2 Then
RangeAddressRepresentsColumn = True
Else
RangeAddressRepresentsColumn = False
End If
End Function
Working in Excel VBA, I have a class module where I define my class 'Marker'. One of the properties of my class is TextLine(), which is an array that holds up to 5 strings. I have defined the two methods below in my class module. In another (regular) module, I fill markerArr() with my custom Marker objects. Loading each object's properties with data at each array index is working fine... However, after loading data into the object at each index, I try to use markerArr(count).ProcessLines but receive a type mismatch error. Since ProcessLines is a public sub in my class module, and markerArr(count) contains a Marker object, I can't seem to understand why this error is occurring... Am I overlooking something obvious?
'Serial number replacement processing function
Public Sub ProcessLines()
Dim strSerial As String
Dim toggle As Boolean
toggle = False
Dim i As Integer
For i = 0 To 4
If Trim(m_TxtLines(i)) <> "" Then
'Add linefeed char to non-empty text lines
m_TxtLines(i) = m_TxtLines(i) & Chr(10)
'Detect if it is a serialized line
If InStr(1, m_TxtLines(i), "XXXXXX-YYY") > 0 Then
m_Serial(i) = True
toggle = True
End If
End If
Next
'When at least one line on the marker is serialized, create and replace serial text
If toggle = True Then
'Only prompt for input once
If startSerNo < 1 And Num_Sers < 1 Then
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1")
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1")
End If
strSerial = CreateSerial(startSerNo)
Dim j As Integer
For j = 0 To 4
If m_Serial(j) Then
m_TxtLines(j) = Replace(m_TxtLines(j), "XXXXXX-YYY", strSerial)
End If
Next
End If
End Sub
'Creates the string to replace XXXXXX-YYY by concatenating the SFC# with the starting serial number
Private Function CreateSerial(ByVal startNum As Integer)
Dim temp
temp = SFC_Num
Select Case Len(CStr(startNum))
Case 1
temp = temp & "-00" & startNum
Case 2
temp = temp & "-0" & startNum
Case 3
temp = temp & "-" & startNum
Case Else
temp = temp & "-001"
End Select
CreateSerial = temp
End Function
Your CreateSerial function takes an integer as a parameter, but you are attempting to pass a string. I've pointed out some problems:
If startSerNo < 1 And Num_Sers < 1 Then 'Here I assume, you have these semi-globals as a variant - you are using numeric comparison here
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1") 'Here startSerNo is returned as a string from the inputbox
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1") 'here Num_Sers becomes a String too
End If
strSerial = CreateSerial(startSerNo) 'here you are passing a String to the CreateSerial function. Either pass an integer, or allow a variant as parameter to CreateSerial
'......more code.....
Private Function CreateSerial(ByVal startNum As Integer)