Does the .value command return strings and if not how do you have an IF statement check if the cell(s) holds the correct string.
I am working on a budget sheet where a certain column sets which department the budget and its breakdown should be forwarded to.
Sub calcMonthly()
Dim ws As Worksheet
Dim wssum As Worksheet
'set worksheets to copy values
Set ws = Sheets("Sheet 1")
Set wssum = Sheets("Sheet 2")
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bumonth As Currency
Dim busum As Currency
'sort through Departments for % breakdown
For k = 0 To 18
'sort through months
For i = 0 To 11
busum = 0
'sort through each item
For j = 0 To 350
bumonth = 0
bumonth = CCur(ws.Cells(3 + j, 37 + k).Value * ws.Cells(3 + j, 24 + i).Value)
busum = busum + bumonth
Next j
'row C holds the string which details if the item if physical hardware or digital then uploads it to the cell
If ws.Cells(3 + j, 3) = "SW" Then
wssum.Cells(3 + k, 2 + i).Value = busum
Else
wssum.Cells(3 + k, 14 + i).Value = busum
End If
Next i
Next k
End Sub
.Value does return a string, but it doesn't look like you included it in the IF statement.
If ws.Cells(3 + j, 3).value = "SW" Then
Range.Value returns a Variant whose subtype depends on the content of the cell.
Given a #N/A, #VALUE, #REF!, or any other cell error value, it returns a Variant/Error that can't be coerced into anything other than a Variant - trying to compare it to a string or numeric value or expression will throw error 13 "type mismatch".
You can avoid this runtime error by evaluating whether the variant subtype is Error using the IsError function, ideally by capturing the cell's value into a local Variant variable first, so you don't have to access the cell twice.
Given an empty cell that has no formula, no value, no content whatsoever, it returns a Variant/Empty; the IsEmpty function can be used to validate this variant subtype.
Given a Date value, it returns a Variant/Date. Given any numeric value, it returns a Variant/Double. Given a TRUE or FALSE value, it returns a Variant/Boolean.
And given a String value, it does return a Variant/String.
Note that the default member of the Range class is a hidden [_Default] property with two optional parameters:
When no parameters are provided, an explicit call to .Value is equivalent. Explicit member calls should generally be preferred over implicit default member calls, and whether implicit or explicit, the calls should be consistent:
If ws.Cells(3 + j, 3) = "SW" Then ' implicit: .Value
wssum.Cells(3 + k, 2 + i).Value = busum
Else
wssum.Cells(3 + k, 14 + i).Value = busum
End If
Related
I'm trying to turn general data written as fractions like 3/4" or 13 7/32" into 3 place decimal numbers such as 0.750 or 13.219.
I have a working table replacement that handles 0 to 1" fractions. It can't handle the mixed numbers like 13 7/32". It leaves me with 13 0.219 which is why I need to replace " 0." with "." to join the 13 and 219 together with a decimal.
We do this data conversion in multiple steps and hand type because Excel tries converting some fractions like 3/4" into a date.
Original data
Resulting data
Sub FractionConvertMTO()
'this section works
For i = 6 To 70
Worksheets("BOM").Range("F6:H48").Select
Selection.Replace what:=Cells(i, 21).Value, Replacement:=Cells(i, 22).Value, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next
'this section doesn't work
For i = 6 To 70
Worksheets("BOM").Range("F6:H48").Select
str1 = " "
str1 = Trim(Replace(str1, " ", "+"))
Next
'this section changes the format.
For i = 66 To 130
Range("F6:H48").NumberFormat = "0.000"
Next
'this section is supposed to add an = sign in front of the cell contents but doesn't work.
Dim Cell As Range
For Each Cell In Range("F6:H48")
Cell.Value = "=" & Cell.Value
Next Cell
'this section works to highlight the first cell
Worksheets("BOM").Cells(1, 1).Select
End Sub
I dug up the following method from my library of useful functions. It converts numbers represented as a fractional string to the numeric equivalent. Simply loop through the cells needing conversion and call this method:
Public Function FractionToNumber(ByVal Value As String, Optional ByVal Digits As Long = 0) As Double
Dim P As Integer
Dim N As Double
Dim Num As Double
Dim Den As Double
Value = Trim$(Value)
P = InStr(Value, "/")
If P = 0 Then
N = Val(Value)
Else
Den = Val(Mid$(Value, P + 1))
Value = Trim$(Left$(Value, P - 1))
P = InStr(Value, " ")
If P = 0 Then
Num = Val(Value)
Else
Num = Val(Mid$(Value, P + 1))
N = Val(Left$(Value, P - 1))
End If
End If
If Den <> 0 Then N = N + Num / Den
FractionToNumber = Round(N, Digits)
End Function
You may also code something like the following:
Sub FractionConvertMTO()
Dim rng As Range
Dim Arr As Variant
Arr = Worksheets("MTO").Range("F6:H48")
For Row = 1 To UBound(Arr, 1)
For col = 1 To UBound(Arr, 2)
str1 = Arr(Row, col)
pos1 = InStr(str1, " ")
pos2 = InStr(str1, "/")
If pos2 = 0 Then
N = val(str1)
Num = 0: Den = 1
Else
If pos1 And pos1 < pos2 Then
N = val(Left$(str1, pos1 - 1))
Num = val(Mid$(str1, pos1 + 1))
Else
N = 0
Num = val(Left$(str1, pos2 - 1))
End If
Den = val(Mid$(str1, pos2 + 1))
End If
Arr(Row, col) = N + Num / Den
Next col
Next Row
Worksheets("MTO").Range("F6", "H48") = Arr
End Sub
If you dispose of the newer dynamic array features (vers. 2019+,MS365) you might write the results in one go to the entire original range (target range) as follows (overwriting the existing range; otherwise define a given offset to identify another target range: rng.Offset(,n)=..).
Tip: make a backup copy before testing (as it overwrites rng)!
Note that this example assumes the " character (asc value of 34).
A) First try via tabular VALUE() formula evaluation
Caveat: converting blanks by VALUE() would be written as #VALUE! results, which would need a further loop. To avoid this you can prefix a zero to the formulae myFormula = "=VALUE(SUBSTITUTE(" & """0""&" & rng.Address & ","""""""",""""))" so that results would be displayed as zero.
Sub ChangeToFractionValues()
'1) define original range to be replaced
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("BOM").Range("F6:H48")
'2) define tabular formula
Dim myFormula As String
'myFormula = "=VALUE(SUBSTITUTE(" & rng.Address & ","""""""",""""))"
'Alternative to avoid #VALUE! displays for blanks:
myFormula = "=VALUE(SUBSTITUTE(" & """0""&" & rng.Address & ","""""""",""""))"
'Debug.Print myFormula
'3) overwrite original range (otherwise code an offset rng.Offset(,n).Value = ...
rng.Value2 = rng.Parent.Evaluate(myFormula)
End Sub
Conclusion due to comment:
Though fast, this approach has a big disadvantage: Excel interpretes date-like numbers as such, transforms them internally to dates by returning the numeric part here, so a cell input of 3/4" would return the corresponding date value of the current year for March 4th.
B) Reworked code based on direct cell evaluations in a loop //Edit
Similar to the above processing this approach is also based on evaluation, but collects all formulae as strings in a variant datafield array v, which allows to manipulate and evaluate each cell input individually:
Sub ChangeToFractionValues()
'1) define original range to be replaced
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("BOM").Range("F6:H48")
'2) assign formula strings to variant 1-based 2-dim data field array
Dim v As Variant
v = rng.Formula2
'3) evaluate results in a loop
Dim i As Long, j As Long
For i = 1 To UBound(v)
For j = 1 To UBound(v, 2)
v(i, j) = Evaluate("0" & Replace(v(i, j), Chr(34), ""))
Next j
Next i
'4) overwrite original range (otherwise code an offset rng.Offset(,n).Value = ...
rng.Value = v
End Sub
str1 = trim(Replace(str1, "0.", "."))
Dim txt As String
Dim i As Integer
Dim reference As Variant
Dim d As Integer
d = Worksheets("Sheet1").cells(Rows.Count, "a").End(xlUp).Row
txt = cells(3, 4).Value
reference = Split(txt, " ")
For i = 0 To UBound(reference)
cells(d + 1, [4]).Value = reference(i)
Next
txt = cells(3, 4).Value
reference = Split(txt, " ")
cells(d + 1, [12]).Value = reference(3)
Hi, im trying to pick the reference before the ubound value each time, and the copy to the reference to the last line. I got this code to work when its the 4th part of the string but im trying to always pick the value before the ubound. Is it possible to do UBOUND -1. or do i have to go another way around this. thanks max
There are basically 2 ways to pick the prelast value.
Option 1 - Using Ubound():
Sub TestMe()
Dim reference As String
reference = "Stack Overflow is my favourite VBA site!"
Dim splitted As Variant
splitted = Split(reference)
Debug.Print splitted(UBound(splitted) - 1)
End Sub
Option 2 - Using predefined function for array length and removing 2 from it:
Calling it this way:
Debug.Print splitted(GetArrayLength(splitted) - 2)
The function:
Private Function GetArrayLength(myArray As Variant) As Long
If IsEmpty(myArray) Then
GetArrayLength = 0
Else
GetArrayLength = UBound(myArray) - LBound(myArray) + 1
End If
End Function
The function is a bit better, because it checks for empty arrays.
Consider the following example: Lets say you want to make a function "JoinIfs" that works just like SUMIFS except instead of adding the values in the SumRange, it concatenates the values in "JoinRange". Is there a way to nest the ParamArray as it seems to be done in SUMIFS?
SUMIFS(sum_range, criteria_range1, criteria1, [criteria_range2, criteria2], ...)
I imagine the declaration should look something like this:
Function JoinIfs(JoinRange As Variant, _
Delim As String, _
IncludeNull As Boolean, _
ParamArray CritArray(CriteriaRange As Variant, Criteria As Variant)) As String
But nothing I try seems to compile and there might not be a way to nest ParamArrays. But the existence of functions like SUMIFS and COUNTIFS seems to suggest there might be a way to nest the ParamArrays.
This question duplicates AlexR's question Excel UDF with ParamArray constraint like SUMIFS. But that was posted a few years ago with no response so either the question didn't get enough attention or it was misunderstood.
Edit for clarification: This question is specifically about nesting ParamArrays. I'm not trying to find alternative methods of achieving the outcome of the example above. Imagine nesting ParamArrays on a completely different fictional function like "AverageIfs"
As per the documentation for the Function statement and Sub statement, a Function or Sub can only contain 1 ParamArray, and it must be the last argument.
However, you can pass an Array as an Argument to a ParamArray. Furthermore, you can then check how many elements are in the ParamArray, and throw an error if it isn't an even number. For example, this demonstration takes a list of Arrays, and which element in that array to take, and outputs another array with the results:
Sub DemonstrateParamArray()
Dim TestArray As Variant
TestArray = HasParamArray(Array("First", "Second"), 0)
MsgBox TestArray(0)
Dim AnotherArray As Variant
AnotherArray = Array("Hello", "World")
TestArray = HasParamArray(AnotherArray, 0, AnotherArray, 1)
MsgBox Join(TestArray, " ")
End Sub
Function HasParamArray(ParamArray ArgList() As Variant) As Variant
Dim ArgumentCount As Long, WhichPair As Long, Output() As Variant, WhatElement As Long
ArgumentCount = 1 + UBound(ArgList) - LBound(ArgList)
'Only allow Even Numbers!
If ArgumentCount Mod 2 = 1 Then
Err.Raise 450 '"Wrong number of arguments or invalid property assignment"
Exit Function
End If
ReDim Output(0 To Int(ArgumentCount / 1) - 1)
For WhichPair = LBound(ArgList) To ArgumentCount + LBound(ArgList) - 1 Step 2
WhatElement = ArgumentCount(WhichPair + 1)
Output(Int(WhichPair / 2)) = ArgumentCount(WhichPair)(WhatElement)
Next WhichPair
HasParameterArray = Output
End Function
(A list of built-in error codes for Err.Raise can be found here)
It seems like nesting a ParamArray is not possible.
I was hoping to get a function that looks like Excel's built in functions.
SUMIFS, for example seems to group pairs of parameters in a very neat way.
Based on the inputs of some users I made the following Function which seems to work quite well.
Function SJoinIfs(JoinRange As Variant, Sep As String, IncludeNull As Boolean, ParamArray CritArray() As Variant) As Variant
'Concatenates text based on multple criteria similar to SUMIFS.
'Sizes of ranges CritArray (0, 2, 4 ...) must match size of range JoinRange. CritArray must have an even amount of elements
'Elements of CritArray (1, 3, 5 ...) must be single values
Set JoinList = CreateObject("System.Collections.Arraylist")
'Set FinalList = CreateObject("System.Collections.Arraylist")
For Each DataPoint In JoinRange
JoinList.Add (CStr(DataPoint))
Next
JoinArray = JoinList.ToArray
CriteriaCount = UBound(CritArray) + 1
If CriteriaCount Mod 2 = 0 Then
CriteriaSetCount = Int(CriteriaCount / 2)
Set CriteriaLists = CreateObject("System.Collections.Arraylist")
Set CriteriaList = CreateObject("System.Collections.Arraylist")
Set MatchList = CreateObject("System.Collections.Arraylist")
For a = 0 To CriteriaSetCount - 1
CriteriaList.Clear
For Each CriteriaTest In CritArray(2 * a)
CriteriaList.Add (CStr(CriteriaTest))
Next
If CriteriaList.count <> JoinList.count Then 'Ranges are different sizes
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
MatchList.Add (CStr(CritArray((2 * a) + 1)))
CriteriaLists.Add (CriteriaList.ToArray)
Next
JoinList.Clear
For a = 0 To UBound(JoinArray)
AllMatch = True
For b = 0 To MatchList.count - 1
AllMatch = (MatchList(b) = CriteriaLists(b)(a)) And AllMatch
Next
If AllMatch Then JoinList.Add (JoinArray(a))
Next
SJoinIfs = SJoin(Sep, IncludeNull, JoinList)
Else 'Criteria Array Size is not even
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
End Function
This function makes use of another function SJoin() which I adapted some time ago based on the answer provided by Lun in his answer to How to replicate Excel's TEXTJOIN function in VBA UDF that allows array inputs.
I have adapted this Function to include the use of Numericals, VBA Arrays and Arraylists as well.
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays
'Go through each item of TxtRng(), depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
ReDim Preserve FinArr(0 To j)
FinArr(j) = "blah"
FinArr(j) = TxtRng(i)
j = j + 1
ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
For Each element In TxtRng(i)
ReDim Preserve FinArr(0 To j)
FinArr(j) = element
j = j + 1
Next
ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
ReDim Preserve FinArr(0 To j)
FinArr(j) = TxtRng(0)(k, l)
j = j + 1
Next
Next
Else
TJoin = CVErr(xlErrValue)
Exit Function
End If
i = i + 1
Loop
'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
OutStr = OutStr & FinArr(i) & Sep
End If
Next
TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator
End Function
Thanks to all who contributed to this question.
When I go to run the VBA code it gives me an error of "Compile Error: Type Mismatch". It doesn't give an error code like it previously has.
It is being used to work on this data. The data on the left is a table that I am running against the values in Row J and assigning the ID in Row M
[Image of Excel][1]
Sub Cat()
Dim i As String
Dim x As String
For i = 1 To 113
For x = 1 To 13
If Sheet1.Cells("B", i).Value = Sheet1.Cells("J", x) Then
Sheet1.Cells("A", i).Value = Sheet1.Cells("M", x)
End If
Next
Next
End Sub
I am expecting IDs of Row A to be inserted where B and M equal as per the for loops
Multiple Type Mismatch
Remember: You can use e.g. Cells(i, "B") or Range("B" & i) for a one-cell range.
The Code
Option Explicit
Sub Cat()
Dim i As Long
Dim x As Long
For i = 1 To 113
For x = 1 To 13
If Sheet1.Cells(i, "B").Value = Sheet1.Cells(x, "J") Then
Sheet1.Cells(i, "A").Value = Sheet1.Cells(x, "M")
End If
Next
Next
End Sub
Aside from the obvious i As String being illegally used as an integer value for loop-counting (should be declared As Long), you are inverting the RowIndex and ColumnIndex arguments of an implicit Range.[_Default] member call:
Sheet1.Cells("B", i).Value
"B" isn't a valid RowIndex value.
Rule of thumb, avoid Range.Cells when you have a string for a column; use it when you have a row index and a column index, i.e. numeric values for row & column.
When you have a column heading string such as "B", use the Range property and concatenate the cell address, e.g. Sheet1.Range("B" & i).
I have the following code that is comparing a combobox on a userform(GUI) to a populated cell on sheet2 of my workbook and I am getting a "type mismatch" error. This was all working until another sub shifted some data into the cells being compared on sheet 2.
My issue lies with if Worksheets(sheet2).cells(1,i).value = LCase(GUI.superCB.Value) then
Worksheets(sheet2).cells(1,i).value Now shows up in the watch as a Variant/Integer which made me think that when the data was shifted it changed the "style" of that cell.
Private Sub NextButton_Click() ''' adds check boxes to frame
Dim i As Integer
'Dim superColm As Integer
For i = 5 To 12
If Worksheets(Sheet2).Cells(1, i).Value = LCase(GUI.superCB.Value) Then 'problem line is right here
superColm = i
Exit For
Else
End If
Next i
NextButton.Visible = False
superCB.Visible = False
Run.Visible = True
Frame1.Visible = True
Dim chk As Control
Dim idx As Integer
Dim lastrow As Integer
lastrow = Worksheets(Sheet2).Cells(Rows.Count, superColm).End(xlUp).Row
For idx = 1 To lastrow - 1
Set chk = GUI.Frame1.Controls.add("Forms.CheckBox.1", idx, True)
'set chk = gui.Frame1.Controls.Add(
chk.Visible = True
chk.Left = 5
chk.Top = (idx - 1) * (chk.Height + 2)
chk.Caption = Cells(idx + 1, superColm) & " " & idx
Next
With Me.Frame1
.ScrollBars = fmScrollBarsVertical
If lastrow <= 10 Then
.ScrollHeight = .InsideHeight * 1.5
ElseIf lastrow <= 15 Then
.ScrollHeight = .InsideHeight * 2.25
ElseIf lastrow <= 20 Then
.ScrollHeight = .InsideHeight * 3
ElseIf lastrow <= 25 Then
.ScrollHeight = .InsideHeight * 3.9
ElseIf lastrow <= 30 Then
.ScrollHeight = .InsideHeight * 4.75
ElseIf lastrow <= 35 Then
.ScrollHeight = .InsideHeight * 5.35
Else
.ScrollHeight = .InsideHeight * 6.25
End If
.ScrollWidth = .InsideWidth * 9
End With
End Sub
If I have sheet 2 as the active sheet Cells(1,i).value will work however, I need to have sheet 2 hidden from the user in the end. With this working it makes me think that the cell style is not the issue.
I have tried going to Excel.Workbooks("Shawn_sch_v1.2.xlsm").worksheets(sheet2).cells(1,i).value and everything down to the base cells() hoping it was missing a sheet reference but nothing has helped.
A String can safely be compared against any other data type in VBA... except Error.
Comparing a Variant/Error against anything will throw a type mismatch error.
This code is implicitly accessing whatever ActiveSheet is:
chk.Caption = Cells(idx + 1, superColm) & " " & idx
Cells should be qualified with the specific Worksheet object you mean to work with. If the active sheet contains a value that can't be coerced into a String (e.g. #VALUE! or #REF!), that will throw a type mismatch error.
Worksheets(Sheet2).Cells(1, i).Value = ...
Here Sheet2 is an identifier. The Worksheets indexer wants either an integer value, or a string. If Sheet2 is the code name of a worksheet in ThisWorkbook, you don't need to dereference it from Worksheets - just use it:
Sheet2.Cells(1, i).Value = ...
The Worksheet class doesn't have a default property, so Debug.Print Worksheets(Sheet2) throws error 438 object doesn't support this property or method - and a subsequent member call like .Cells(1, i), also throws a type mismatch error. If you don't have a Sheet2 string variable holding a worksheet name, I suspect that's the bug you're having right now... which means everything above is just what's waiting to bite you :)
If Sheet2 is a string variable that contains a valid sheet name, you can use the IsError function to verify whether a Variant is a Variant/Error:
If Not IsError(Sheet2.Cells(1, i).Value) Then
' value is safe to compare against a string
Else
' comparing the cell value to anything will throw error 13
End If
Lastly, I would advise against using Rows as a global variable, since it's already a global-scope identifier ([_Global].Rows, implicitly referring to ActiveSheet). Now, renaming that variable with Find/Replace is going to be pretty hard to do without breaking your code: Rubberduck's "rename" refactoring could probably help with doing that safely (disclaimer: I manage that OSS VBIDE add-in project).
This will be fixed with doing a check on the range object data type first.
Worksheets(Sheet2).Cells(1, i).Value is the range object. This can change data types every time the range is modified depending on how it is modified.
LCase(GUI.superCB.Value) This appears to be a form control. If the range is an integer, they cannot compare.
Try something like this:
Dim i As Integer
Dim iRange as String
'Dim superColm As Integer
`This is untested
For i = 5 To 12
iRange = Worksheets(sheet2).Cells(1, i).Text
If iRange = LCase(GUI.superCB.Value) Then 'problem line is right here
superColm = i
Exit For
Else
End If
Next i
The idea is to first be sure that the data types are the same.
You may need to use .Text or .Value2 instead of .Value for the range. If it is possible that the range object will be Empty or Nothing , then you also need to check for those too.
Edit: Changed .Value to .Text
Edit2: This answer is incorrect.