I am trying to search if a number exists in one of the 32 sheets I have in my workbook.
I have tried to use the below mentioned code but it's not working because VLOOKUP is not deciphering the variable(n). Kindly help:
Private Sub SearchAll_Click()
Dim SearchCriteria As Double, s As Integer
SearchCriteria = Me.SearchBox.Value
s = 0
For s = 0 To ThisWorkbook.Sheets.Count
s = s + 1
If Application.WorksheetFunction.VLookup(SearchCriteria, Sheets(s).Range("A:A").Value, 1, False) = SearchCriteria Then
MsgBox ("The Number " & SearchCriteria & " is available in list " & Sheets(s).Name)
Exit For
Else
MsgBox ("The Number is Unavailable")
End If
Next s
End Sub
Legend:
SearchAll is a button used to initiate the search.
SearchCriteria is a textbox used to input the value you want to search for.
There are a few problems in the way you use Application.WorksheetFunction.VLookup to determine if a specific value exists in your workbook. I have modified your code to the following:
Private Sub SearchAll_Click()
Dim SearchCriteria As Double, s As Integer
Dim Lookup As Variant
Dim Match As Boolean
SearchCriteria = Me.SearchBox.Value
For s = 1 To ThisWorkbook.Sheets.Count
Lookup = Application.VLookup(SearchCriteria, Sheets(s).Range("A:A"), 1, False)
If Not IsError(Lookup) Then
MsgBox ("The Number " & SearchCriteria & " is available in list " & Sheets(s).Name)
Match = True
Exit For
End If
Next s
If Match = False Then MsgBox ("The Number is Unavailable")
End Sub
Here I have, instead, made use of Application.VLookup which will return an error to the variant variable Lookup if the search value were not found in the specific sheet. Then, by looking at the error state of Lookup it can be determined if the search value were found. Also, I have moved the message The Number is Unavailable outside the loop in order to avoid it being triggered each time the value were not found in a specific sheet.
Related
I have a button that prints a form on the current record.
The form contains a combobox with something like: 123005TEST
This combobox is a lookup to another textbox which is a combination of three text boxes(on a different form):
=([OrderNr] & (""+[Aantal]) & "" & [SapArtNr])
OrderNr is 12300 and Aantal is 5 and SapArtNr is TEST, creating: 123005TEST
My question is, when I click print, is it possible to print a certain amount of copies based on Aantal 5, so printing 5 copies.
And here comes the tricky part.
To have each printed copy a different value in the combobox, so the first copy would have this written in the combobox on the printed paper: 123001TEST and copy two would be 123002TEST and so on, until 5.
I didn't understand which textbox will receive the sequential text. So I put a dummy in the example code:
Option Explicit
Private Sub cmdPrintIt_Click()
Dim strOrderNr As String
Dim strAantal As String
Dim strSapArtNr As String
Dim intHowManyCopies As Integer
Dim intCopy As Integer
Dim strToTextBox As String
strOrderNr = Me.OrderNr.Text
strAantal = Me.Aantal.Text
strSapArtNr = Me.SapArtNr.Text
On Error Resume Next
intHowManyCopies = CInt(strAantal)
On Error GoTo 0
If intHowManyCopies <> 0 Then
For intCopy = 1 To intHowManyCopies
strToTextBox = strOrderNr & CStr(intCopy) & strSapArtNr
Me.TheTextBoxToReceiveText.Text = strToTextBox
'put your code to print here
Next
Else
MsgBox "Nothing to print! Check it."
End If
End Sub
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'm creating a database on Excel, and encountered some problems as I tried to assign auto number to each row.
Requirements are:
generate auto number to each row(on the column A) when column B is not blank.
the number should be unique and must always be connected to the contents of the same row even when the column is sorted or when new rows are inserted, etc.
when a new row is inserted (anywhere on the same column), a new number should be assigned (the newest number should be the biggest number)
if
possible, the auto number should have a prefix, and number should be displayed in four digits (e.g. 0001, 0011)
I have tried some VBA codes I found from other people's questions (e.g. Excel VBA : Auto Generating Unique Number for each row).
So far, the code below has worked the best, but the requirement (3) and (4) couldn't be solved by that code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
I'm short of the knowledge of VBA and I hope someone could help me this.
Many thanks.
Alternative via CustomDocumentProperties
Instead of using a hidden sheet as proposed by #TimWilliams, one can assign incremented values to a user defined custom document property (CDP), naming it e.g. "InvNo" holding the newest invoice number. The cdp remain stored in the saved workbook.
The function below gets the current number saved to this workbook related property and returns the next number by adding 1 to the current value. It uses a help procedure RefreshCDP to assign the new value (could be used of course independantly to reset values programmaticaly to any other value). - If the cdp name isn't passed as (optional) argument, the function assumes "InvNo" by default.
Note that code requires some error handling to check if the cdp exists.
Example call
Dim InvoiceNumber as Long
InvoiceNumber = NextNumber("InvNo") ' or simply: NextNumber
Public Function NextNumber(Optional CDPName As String = "InvNo") As Long
'a) get current cdp value
Dim curVal As Long
On Error Resume Next
curVal = ThisWorkbook.CustomDocumentProperties(CDPName)
If Err.Number <> 0 Then Err.Clear ' not yet existing, results in curVal of 0
'b) increment current cdp value by one to simulate new value
Dim newVal As Long
newVal = curVal + 1
'Debug.Print "Next " & CDPName & " will be: " & newVal
'c) assign new value to custom document property
RefreshCDP CDPName, newVal, msoPropertyTypeNumber
'Debug.Print "New " & CDPName & " now is: " & ThisWorkbook.CustomDocumentProperties(CDPName)
NextNumber = newVal
End Function
Help procedure RefreshCDP
Sub RefreshCDP(CDPName As String, _
newVal As Variant, docType As Office.MsoDocProperties)
On Error Resume Next
ThisWorkbook.CustomDocumentProperties(CDPName).Value = newVal
'If cdp doesn't exist yet, create it (plus adding the new value)
If Err.Number > 0 Then
ThisWorkbook.CustomDocumentProperties.Add _
Name:=CDPName, _
LinkToContent:=False, _
Type:=docType, _
Value:=newVal
End If
End Sub
Related links
MS help: Excel.Workbook.CustomDocumentProperties
Check if BuiltInDocumentProperty is set without error trapping
Chip Pearson: Document Properties
How to add a DocumentProperty to CustomDocumentProperties in Excel?
Do not use Max() to find the next number - use instead a hidden sheet or name to store the current number, and increment it each time a new Id is required.
For example:
Public Function NextNumber(SequenceName As String)
Dim n As Name, v
On Error Resume Next
Set n = ThisWorkbook.Names(SequenceName)
On Error GoTo 0
If n Is Nothing Then
'create the name if it doesn't exist
ThisWorkbook.Names.Add SequenceName, RefersTo:=2
v = 1
Else
'increment the current value
v = Replace(n.RefersTo, "=", "")
n.RefersTo = v + 1
End If
NextNumber = v
End Function
This allows you to use multiple different sequences as long as you give each one a distinct name.
Dim seq
seq = NextNumber("seqOne")
'etc
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)