VBA behaving weirdly, can't get the value stored in variable - excel

I am having a very strange problem. I am not able to get the value returned from a simple function as below if the return value is more than one char. Now the second problem is that following code is not assigning "WTH" to sheetName variable. Refer to the screenshot 2. UPDATED AFTER CYRIL'S COMMENTS
Public Sub WTHFormatter()
Dim sheetName As String
sheetName = "WTH"
Dim rng1 As Range
'delete empty rows
lastRowWTH = getLastRow(sheetName, 2)
'Delete rows below the last Row
Worksheets(sheetName).Rows(lastRowWTH + 1 & ":" & Worksheets(sheetName).Rows.Count).Delete
' build first range
Set rng1 = Worksheets(sheetName).Range("B11:F" & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range("H11:K" & lastRowWTH)
Call setCellBorders(rng1)
'determine the range for months
For i = 13 To 24
If Cells(7, i) = "" Then
lastCol = i - 1
Exit For
End If
lastCol = i
Next
ColLetter = returnLabel(lastCol)
ColLetter2 = returnLabel(lastCol + 2)
ColLetterX = returnLabel(lastCol + 14)
Set rng1 = Worksheets(sheetName).Range("K17:" & ColLetter & lastRowWTH)
Call setCellBorders(rng1)
Set rng1 = Worksheets(sheetName).Range(ColLetter2 & lastRowWTH & ":" & ColLetter3 & lastRowWTH)
Call setCellBorders(rng1)
End Sub
Function returnLabel(num1 As Long) As String
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, num1).Address, "$")(1)
returnLabel = ColumnLetter
End Function
The above function returns blank and varTest has nothing after the execution. If I do the line by line execution, I see that test1 in function is not 'Null'.
If I break the execution and probe the variables I see "test1 =" only as per the screen shot below. And this is breaking my code.
Strangely, If I call the function from 'Immediate Window', it returns the expected value.
Things I have already done:
I have tested in a fresh file using simple code as above.
Tested in different PC and the same code is working fine with same version of Windows 10 & Office 365.
Updated / Re-installed MS Office 365
Restarted the PC
If the return value is a single character like "A", the code is working fine.
Failed to understand the reason here. Any help is appreciated.
UPDATE1
I tried it on a fresh file while the code above worked, but the main code is having a new similar problem. This has started happening just now. It's not assigning a string value to the variable. See the attached screenshot.Screenshot of the VBA Code. I am assuming there is some problem with system or some virus.

If the idea is to have a function, that an array, this is possible with the following code:
Function Test1() As Variant
ReDim result(2)
result(0) = "AJ"
result(1) = "A"
Test1 = result
End Function
Sub Main()
Dim varTest As Variant
varTest = Test1(0)
Debug.Print varTest
varTest = Test1(1)
Debug.Print varTest
End Sub
It is questionable why would it be needed, but as a "test-exercise" it is ok.

Going to put my comments into an answer to consolidate and add more explanation.
Pointing out some errors in the code before correcting:
Function test1(num1) 'declare `as variant` to ensure you're returning an array
test1 = "AJ" 'this appears to be saving a single string to var test1
test1 = "A" 'you are now overwriting the above string
End function
Sub test()
varTest = test1(1) 'you have a single string from the function and arrays start at 0, not 1
End sub
You would want to specify the place in the array, after declaring an array, within your function such that:
Function test1() As Variant
Dim arr(2) As Variant 'added array because test1 = BLAH is the final output in a function
arr(0) = "AJ" 'added (1) to call location in array
arr(1) = "A" 'added (2) to call location in array
test1 = arr
End Function
Sub test()
Dim varTest As Variant
varTest = test1(0) 'outputs "AJ" in immediate window
Debug.Print varTest
End Sub
Now you can debug.print your array values, or set to varTest based on the location in the array.
Edit: Tested after my consolidating comments and recognized that there was not an actual output for test1 as an array at the end of the function, so had to go back and add a second array to set test = allowing an array output from a function.

Your code is running as it should.
The test1 function assigns the value AJ to the test1 variable, and then it assigns the value A to the test1 variable.
You could assign the value 50 in your test procedure and it will return A.
I think this is the code you're after:
Function test1(num1) As String
' Dim MyArray As Variant
' MyArray = Array("AJ", "A")
'OR
Dim MyArray(0 To 1)
MyArray(0) = "AJ"
MyArray(1) = "A"
If num1 >= LBound(MyArray) And num1 <= UBound(MyArray) Then
test1 = MyArray(num1)
Else
test1 = "Item not here"
End If
End Function
Sub test()
Dim varTest As String
'Return the second item in the array from the function.
varTest = test1(1)
MsgBox varTest
'Return the first item in the array from the function.
varTest = test1(0)
MsgBox varTest
'Returns "subscript out of range" error as array is only 2 elements in size (0 and 1).
'The error is dealt with in the function using the IF....ELSE...END IF block and returns
'"Item not here" instead.
varTest = test1(2)
MsgBox varTest
End Sub

I solved this by using declaring the variables even when option explicit is not used.
The old code runs without throwing errors even when the variable is not declared and option explicit is also not used. But, for some reasons, it doesn't read / write undeclared variables as expected.
Now as per #cyril suggestion, I declared the variables being used and run the code. This time code ran as expected.
This happened for multiple of variables and at different stages in the code.

Related

How do I join the word "Sheet" and an integer to form sheet code name

How can I concatenate the word "Sheet" with a number (say, 2) to form a string that can be used as the code name of a sheet.
I've tried the following piece of code but it doesn't seem to work.
Sh = "Sheet" & 2
Range("A1") = Sh.index
If you want to refer the sheet just based on index you could try something like this as well ... hope it works for you
Sub trial()
i = 2
Sheets(i).Select
End Sub
I assume you want to check if a given ►string argument (CodeNameString) refers to a valid Code(Name) in the VBA project. *)
If so, the following function returns the worksheet to be set to memory; otherwise the second argument IsAvailable passed by reference will change to False and can be used for error checks (c.f. ExampleCall below).
Function SheetByCodename(ByVal CodeNameString As String, ByRef IsAvailable As Boolean) As Object
'check for same CodeName in Sheets collection
Dim ws As Object
For Each ws In ThisWorkbook.Sheets
If ws.CodeName = CodeNameString Then ' check for string identity
Set SheetByCodename = ws ' set sheet object to memory
IsAvailable = True ' assign true to 2nd argument passed ByRef
Exit For
End If
Next
End Function
Example call
Sub ExampleCall()
dim cnt As Long: cnt = 2 ' << change example counter
Dim okay As Boolean ' << needed variable passed as 2nd function argument
With SheetByCodename("Sheet" & cnt, okay)
If okay Then
Debug.Print _
"a) Worksheet Name: " & .Name & vbNewLine & _
"b) Sheet's Code(Name) in Project: " & .CodeName
Else
Debug.Print "Given string refers to no valid Code(Name)."
'do other stuff to handle the wrong input
End If
End With
End Sub
*) Take note of #RonRosenfeld 's important remarks in comment:
"Codename is assigned when the worksheet is created. It can be changed in the properties window. In order to change it programmatically, you need to enable Trust Access to the VBA object model. Otherwise, it's a read-only property. "

Writing to a worksheet from a VBA function

I am trying to write some intermediate results in a user defined VBA function to a worksheet. I have tested the function, and it works correctly. I am aware that I cannot modify / write to cells from a UDF, so I tried passing the relevant results to a subroutine which I hoped would then be able to write to the spreadsheet.
Unfortunately my scheme doesn't work, and I am trying to think through this problem.
Public Function f(param1, param2)
result = param1 * param2
call writeToSheet(result)
f = param1 + param2
end
public sub writeToSheet(x)
dim c as range
c = range("A1")
c.value = x
end
I would like to see the product of param1 and param2 in cell A1. Unfortunately, it does not happen - the subroutine just ends abruptly as soon as it attempts to execute the first statement (c = range("A1") ). What am I doing wrong, and how can I fix it?
If it is simply impossible to write to a spreadsheet in this way, is there some other way in which to store intermediate results for later review? My real life problem is a little more complicated that my stylized version above, as I generate a new set of intermediate results each time I go through a loop, and want to store them all for review.
This idea might work for you. The function ParamProduct calls SetProps which writes both parameters to custom document properties (View from File > Properties > Advanced Properties > Custom). Call the function with =ParamProduct(A1, A2) or =ParamProduct(123, 321)
Function ParamProduct(Param1 As Variant, _
Param2 As Variant) As Double
Dim Fun As Double
Dim Param As Variant
Dim i As Integer
Param = Param1
For i = 1 To 2
SetProp "Param" & i, Param
Param = Param2
Next i
ParamProduct = Param1 + Param2
End Function
Private Sub SetProp(Pname As String, _
PropVal As Variant)
' assign PropVal to document Property(Pname)
' create a custom property if it doesn't exist
Dim Pp As DocumentProperty
Dim Typ As MsoDocProperties
If IsNumeric(PropVal) Then
Typ = msoPropertyTypeNumber
Else
Select Case VarType(PropVal)
Case vbDate
Typ = msoPropertyTypeDate
Case vbBoolean
Typ = msoPropertyTypeBoolean
Case Else
Typ = msoPropertyTypeString
End Select
End If
On Error Resume Next
With ThisWorkbook
Set Pp = .CustomDocumentProperties(Pname)
If Err.Number Then
.CustomDocumentProperties.Add Name:=Pname, LinkToContent:=False, _
Type:=Typ, Value:=PropVal
Else
With Pp
If .Type <> Typ Then .Type = Typ
.Value = PropVal
End With
End If
End With
End Sub
Use this UDF to recall the properties to the worksheet.
Function GetParam(ByVal Param As String) As Variant
GetParam = Propty(Param)
End Function
Private Function Propty(Pname As String) As Variant
' SSY 050 ++
' return null string if property doesn't exist
Dim Fun As Variant
Dim Pp As DocumentProperty
On Error Resume Next
Set Pp = ThisWorkbook.CustomDocumentProperties(Pname)
If Err.Number = 0 Then
Select Case Pp.Type
Case msoPropertyTypeNumber
Fun = CLng(Fun)
Case msoPropertyTypeDate
Fun = CDate(Fun)
Case msoPropertyTypeBoolean
Fun = CBool(Fun)
Case Else
Fun = CStr(Fun)
End Select
Fun = Pp.Value
End If
The worksheet function below works (A6 has a value of "Param2")
=GetParam("Param1")*GetParam(A6)
The above code will create a property if it doesn't exist or change its value if it does. The sub below will delete an existing property and do nothing if it's called to delete a property that doesn't exist. You might call it from one of the above subs or functions.
Private Sub DelProp(ByVal Pname As String)
On Error Resume Next
ThisWorkbook.CustomDocumentProperties(Pname).Delete
Err.Clear
End Sub
Thanks a mill everyone. Printing to the immediate window is the easiest by far, but allowed me to print only a single item. I therefore concatenated all 5 items into a single string and printed it in the immediate window:
dummystr = CStr(slope1) & ", " & CStr(intercept1) & ", " & CStr(slope2) & ", " & CStr(intercept2) & ", " & CStr(sse(i))
Debug.Print dummystr

Run time error '1004' Application defined or object defined error on Vlookup function

I am trying to utilize Vlookup function, according to the Textbox1 value user put in in Userform Guntest, automatically looking for corresponding features of the gun.
However the program currently doesn't run as it reminds me
'Runtime error '1004', method 'Range of object' _Global' failed.
The error appears on Retrieve1=…
I will be appreciated if you could help me to check where the problem is as I have really limited knowledge and experience on using VBA.
Thanks in advance.
It looks like some objects is undefined but I can't figure out where.
The module 1 code is:
Public Guncode As String
Option Explicit
Sub Test()
Call Vlookup
End Sub
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With Sheets(1)
FinalRow = Range("A65536").End(xlUp).Row
FinalColumn = Range("IV1").End(xlToLeft).Column
WholeRange = "A2:" & CStr(FinalColumn) & CStr(FinalRow)
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
The userform code is:
Option Explicit
Private Sub Label1_Click()
End Sub
Private Sub CommandButton1_Click()
If TextBox1 = "" Then Exit Sub 'Set condition 1 of exiting the program
Guncode = GunTest.TextBox1
With Me
Call Module1.Test
End With
End Sub
Private Sub PartID_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub
It should run properly but it doesn't. Any help would be appreciated, thanks!
First off, you were passing in a number as the column letter value. CSTR() doesnt magically transform it into the letter equivalent but I like your enthusiasm.
Second, your method will bomb if the value isnt found - so you'll need to write your own error handling for it.
Sub Vlookup()
Dim Retrieve1 As String
Dim Retrieve2 As String
Dim FinalRow As Long
Dim FinalColumn As Long
Dim WholeRange As String
Dim vArr
Dim col_Letter As String
If GunTest.TextBox1 = "" Then
Exit Sub
If GunTest.TextBox1 <> "" Then
MsgBox Guncode
End If
End If
With ThisWorkbook.Sheets("Sheet1")
FinalRow = .Range("A65536").End(xlUp).Row
FinalColumn = .Range("IV1").End(xlToLeft).Column
vArr = Split(Cells(1, FinalColumn).Address(True, False), "$")
col_Letter = vArr(0)
WholeRange = "A2:" & col_Letter & CStr(FinalRow) '<---- you were passing a number in as the column value
Retrieve1 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 1, False) 'Locate specific tool according to QR code number
Retrieve2 = Application.WorksheetFunction.Vlookup(Trim(Guncode), .Range(WholeRange), 5, False) 'Locate specific gun type according to QR code number
If Guncode = "" Then
MsgBox "This gun doesn't exist in database!"
Else
MsgBox "The tool number is:" & Retrieve1 & vbCrLf & "The gun type is:" & Retrieve2
End If
End With
End Sub
1. I am not sure what is the reason using Address(True, False) for row number.
This comes from a combination of these two functions. The true/false setting is telling the funciton to use/not use absolute references in the address.
Split ( expression [,delimiter] [,limit] [,compare] )
https://www.techonthenet.com/excel/formulas/split.php
expression.Address (RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo)
https://learn.microsoft.com/en-us/office/vba/api/excel.range.address
Shouldn't Cell (1, FinalColumn) stands for the column number?
No, the cells fucntiosn basically returns an intersection/address of rows & column.
Try this for example: debug.Print; thisworkbook.Sheets("Sheet1").Cells(2,2)
You mentioned CSTR doesn't magically transform to letter equivalent so what would it transform to? Could you further elaborate?
This is a data type conversion function. CSTR(666) essentially does this: this 666 becomes this "666"
2. vArr(0). I am confused with what does the parameter 0 stands for in the bracket. Actually this is a general question I always have regarding to parameter specification.
This is an array position refence. The split function returns an array of strings. Since we're using to capture the column label value, we only need to reference the first position.
(3) I tried copy your code and run it but still reminds me error on the same row.
Works fine for me unless there is no returning value, which returns an error which is what I meant by "bomb."

Excel VBA - how to find the largest substring value in a column

I have a column in a spreadsheet.
The format of the data in each cell is aa-0001-xx.
I need to examine the whole column to find the highest value of the sequence number. this would be the substring from column4 thru column7.
I can find the sequence number using Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4)
But I need to find the max sequence in the whole column.
I am doing this in VBA.
Any help would be appreciated.
Here is my code so far:
Private Sub CommandButton1_Click()
Dim sQuoteNumber As String
Dim sFileName As String
Dim sPathName As String
Dim checkit As String
'Log the Quote
'First, open the log file and determine the next sequential log number.
sPathName = "C:\Users\Rich\Documents\Bryan\BigProject\"
sFileName = "QuoteLog2016.xlsx"
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=sPathName & sFileName
'Create the new Quote Number
checkit = Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) ' This is a temp test line
If Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) = "" Then
sQuoteNumber = "16-0001"
Else
'find the biggest number
'Here I was looking to like pass the mid function to a Max function of some sort.
sQuoteNumber = "16-0002"
End If
MsgBox ("The new Quote Number is: " + sQuoteNumber)
'Save the log entry
Workbooks(sFileName).Close
All of the comments made to your answer would work well for you. It's also true that there's no evidence in your code at having attempted something, however rudimentary, and this is why answers to a rather trivial task are not forthcoming for you. Perhaps, in future, have a go at some kind of solution ( even if it feels more guesswork than anything) and people on this site will be much more supportive of you.
To set you on your way, you could make use of the Split() function which converts a String into a String array, separated by a nominated value - in the case of your quotations, you could use "-" as your separator. This might be easier than your Mid function and will deal with the case of different sized quotations.
The code below will get you started but you'd want some error handling in there to test, for example, that each cell splits appropriately or that any cells aren't blank. I'll leave all of that to you.
Option Explicit
Private mLastQuote As Long
Public Sub Test()
Initialise 'call this routine just once at the start of your project
MsgBox GetNextQuote(16) 'use the GetNextQuote() function to get next number
MsgBox GetNextQuote(16)
MsgBox GetNextQuote(16)
End Sub
Private Function GetNextQuote(prefix As Integer) As String
mLastQuote = mLastQuote + 1
GetNextQuote = CStr(prefix) & "-" & _
Format(mLastQuote, "000#")
End Function
Private Sub Initialise()
Const PATH_NAME As String = "C:\Users\Rich\Documents\Bryan\BigProject\"
Const FILE_NAME As String = "QuoteLog2016.xlsx"
Const QUOTE_COL As String = "B"
Dim wb As Workbook
Dim ws As Worksheet
Dim v As Variant
Dim r As Long
Dim parts() As String
Dim num As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Open(PATH_NAME & FILE_NAME, True, True)
Set ws = wb.Worksheets("Sheet1")
'Read quote values into variant array
With ws
v = .Range(.Cells(2, QUOTE_COL), _
.Cells(.Rows.Count, QUOTE_COL).End(xlUp)) _
.Value2
End With
'Find max quote
For r = 1 To UBound(v, 1)
parts = Split(v(r, 1), "-") 'splits quote into 3 parts
num = CLng(parts(1)) 'index (1) is the middle part
If num > mLastQuote Then mLastQuote = num
Next
wb.Close False
Application.ScreenUpdating = True
End Sub

Error When Running VBA Code

I am Trying to run this code but it keeps giving me an error message while compiling
Argument not optional
I am using a function called csvRange
Sub CS()
csvRange()
End Sub
Function csvRange(FirstNum, SecondNum) As Double
i As Integer
For i = FirstNum.Value To SecondNum.Value
csvRange = csvRange & i & "+"
Next
End Function
can anyone help.
you want to call csvRange() but csvRange requires 2 arguments to pass.
And you forgot to save the return value.
for example
Sub CS()
var first = 1
var second = 50
var result
result = csvRange(first, second)
End Sub
Function csvRange(FirstNum, SecondNum) As Double
i As Integer
For i = FirstNum.Value To SecondNum.Value
csvRange = csvRange & i & "+"
Next
End Function
A couple of remarks:
- You call the function csvrange without parametervalues which you did not define as being optional.
- You do nothing with the value the function returns
- the i is an integer and the result a double. it is bad practice to mix them both in your for-next loop
Your code requires a few fixes:
1) Use appropriate arguments for csvRange.
2) Use the return value of csvRange for something (this is not mandatory, but typically required in well designed code).
3) Declare the type of arguments for csvRange.
4) You seem to be using csvRange to get a String. Change code accordingly.
You would use something like
Sub CS()
Dim rng1 As Range, rng2 As Range
Set rng1 = ...
Set rng2 = ...
Set retval As String
retval = csvRange(rng1, rng2)
End Sub
Function csvRange(FirstNum As Range, SecondNum As Range) As String
i As Integer
csvRange = ""
For i = FirstNum.Value To SecondNum.Value
csvRange = csvRange & Cstr(i) & "+"
Next i
End Function
PS1: Your output will end with a trailing "+". Perhaps this is not what you want.
PS2: I do not have a system to test this code.

Resources