I am having a problem with a particular line of code:
ActiveSheet.Range("A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount)
Where alphabet is a string containing uppercase letters A to Z.
I keep getting the following error:
Run-time error '5':
Invalid Procedure call or argument
I tried creating a String "inRange" and changing the code to this:
inRange = "A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
curRange = ActiveSheet.Range(inRange)
But that did not help (as I thought it wouldn't). Any suggestions?
Although creating ranges like this is frowned upon in general, the way to do it is with the word SET (like #Gary McGill stated in the comments). Here is an example of how to do this:
Sub test()
Dim alphabet As String
Dim totHrdrLngth As Long
Dim belowRowCount As Long
Dim rowCount As Long
Dim inRange As Range
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
totHrdrLngth = 5
belowRowCount = 10
rowCount = 5
' Gives us A5:E10
Set inRange = Range("A" & rowCount & ":" & range2 & _
Mid$(alphabet, totHrdrLngth, 1) & belowRowCount)
End Sub
You are running this macro in the current range, so there should be no need to specify ActiveSheet.Range. I hope this helps get you toward what you are trying to achieve.
As far as I can tell, you're getting an error because your types don't match up. I imagine rowCount is an integer, as is belowRowCount. If you convert them to strings before concatenating them, you can fix it. str() will convert an integer to a string with a space before it, and LTrim() will remove the space. Try code as below:
Dim sRowCount As String
Dim sBelowRowCount As String
and later
sRowCount = LTrim(Str(RowCount))
sBelowRowCount = LTrim(Str(belowRowCount))
inRange = "A" & sRowCount & ":" & Mid(alphabet, totHdrLngth, 1) & sBelowRowCount
curRange = ActiveSheet.Range(inRange)
Hope this helps.
Related
I have 20 cases. For every row in my sheet, I have a cell that assigns related case numbers to it. A row could have multiple case numbers assigned to it in that cell (Example: 1,2,11,12)
I am writing a code to copy all the rows that have Case number 1 assigned to them, copy them someplace else..
and then go to case number 2 and repeat the same..
This is what I am using:
For CaseNumbers = 1 To 20
For i = Row1 To RowLast
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
COPY AND PASTE CODE
End If
Next
Next
The problem I am facing is, the code considers case number 11 as case number 1 too (since it has the digit 1).
This is the first time I am writing a VBA code and I have no background in this.
Can someone please advise on better way of doing this? Should I assign a checklist instead to each row?
All I want to do is find all the rows that have Case number 1 assigned, copy them.. then find all the rows that have Case 2 assigned, copy them.. and so on.
Please help.
You can use a function to do the test
Public Function isCaseNumberIncluded(ByVal caseToCheck As Long, ByVal caseNumbers As String) As Boolean
'add , to make all values distinct
caseNumbers = "," & caseNumbers & ","
Dim strCaseToCheck As String
strCaseToCheck = "," & caseToCheck & ","
If InStr(1, caseNumbers, strCaseToCheck) > 0 Then
isCaseNumberIncluded = True
End If
End Function
You would call this function within your main code like this:
Dim caseNumber As Long 'I removed the s - as this could be misleading in my eyes
For caseNumber = 1 To 20
For i = Row1 To RowLast
If isCaseNumberIncluded(caseNumber, Range(CaseNoCell & i).Value) Then
COPY AND PASTE CODE
End If
Next
Next
Using a separate function to run the test has two advantages:
your code gets more readable, ie you know from reading the functions name what the result should be - without reading the whole code how to do it :-)
you can re-use this code propably at another place
Or you can test the function first:
Public Sub test_isCaseNumberIncluded()
Debug.Print isCaseNumberIncluded(1, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(1, "2,11,12"), "Should be false"
Debug.Print isCaseNumberIncluded(11, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(11, "1,2,12"), "Should be false"
End Sub
Well, you are working with this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
This checks against 1,, 12,, ..., but obviously it won't cover the last entry so that's something you'll need to add. And you have the problem that 11, gets treated as 1,.
In a similar way you can use this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, "," & CaseNumbers & ",") Then
This checks against ,1,, ,12,, ... so it will solve your error, but obviously it won't cover the last and the first entry so that's something you'll need to add.
This is something that should be encapsulated in a function rather than being done in line. The method provided in VBA for tokenising a string is 'Split'.
You could wite a function that checks tokens 1 by 1, or which compile a collection of the tokens which then uses a built checking method of the collection to determine if the specified token is present or not.
In this specific case I've chosen to use the collection method. The specific object for the collection is the ArrayList (but a Scripting.Dictionary is also possible). The function contains checks for zero length strings and allows the seperator to be specified if it isn't a comma.
Option Explicit
Function FindToken(ByVal ipToken As String, ByVal ipTokenList As String, Optional ByVal ipSeparator As String = ",") As Boolean
' Guard against ipSeparator being vbnullstring
Dim mySeparator As String
mySeparator = IIf(VBA.Len(ipSeparator) = 0, ",", ipSeparator)
'Raise an error if ipToken or ipTokenList are empty strings
If VBA.Len(ipToken) = 0 Or VBA.Len(ipTokenList) = 0 Then
Err.Raise 17, "Empty string error"
End If
'Convert the token list to tokens
Dim myTokens As Variant
myTokens = VBA.Split(ipTokenList, mySeparator)
' Put the tokens in an ArrayList so we can use the contains method
' no point is doing early binding as arraylist doesn't provide intellisense
Dim myAL As Object
Set myAL = CreateObject("System.Collections.ArrayList")
Dim myItem As Variant
For Each myItem In myTokens
' Trim just in case there are spaces
myAL.Add VBA.Trim(myItem)
Next
'Finally test if the Token exists in the token list
Find = myAL.contains(VBA.Trim(ipToken))
End Function
This means that your code
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
can now be rewritten as
If FindToken(CStr(CaseNUmbers), Range(CaseNoCell & cstr(i)).Value) Then
Identify Criteria Rows
Option Explicit
Sub Test()
Const WordSeparator As String = ","
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim CaseNumber As Long
Dim i As Long
Dim cValue As Variant
Dim cString() As String
For CaseNumber = 1 To 20
For i = Row1 To RowLast
cValue = CStr(ws.Range(CaseNoCell & i).Value)
If Len(cValue) > 0 Then
cString = Split(cValue, WordSeparator)
If IsNumeric(Application.Match( _
CStr(CaseNumber), cString, 0)) Then
' CopyAndPasteCode CaseNumber
Debug.Print "Case " & CaseNumber & ": " & "Row " & i
End If
End If
Next i
Next CaseNumber
End Sub
I am working on a workbook in which I need to count how many times the "St/" substring is present in a Range (Column Q). Note: I am interested in all the occurrences, not just the number of cells in which the substring is present.
Here is the code I am trying to work with (based on the comment of Santhosh Divakar - https://stackoverflow.com/a/23357807/12536295), but I receive a runtime error (13) when running it. What am I missing / doing wrong?
Dim lastrow, q as Integer
lastrow = Range("A1").End(xlToRight).End(xlDown).Row
With Application
q = .SumProduct((Len(Range("Q1:Q" & lastrow)) - Len(.Substitute(Range("Q1:Q" & lastrow), "St/", ""))) / Len("St/"))
End With
See if the code below helps you:
Public Sub TestCount()
lastrow = Range("Q" & Rows.Count).End(xlUp).Row
strformula = "=SUMPRODUCT(LEN(Q1:Q" & lastrow & ")-LEN(SUBSTITUTE(UPPER(Q1:Q" & lastrow & "),""/ST"","""")))/LEN(""/St"")"
MsgBox Evaluate(strformula)
End Sub
I think you can count the number of characters, replace your "St/" with nothing and then count the characters again and divide by len("St/"). Here's an example.
'''your existing code
Dim lCount As Long
Dim lCount_After As Long
'''set a Range to column Q
Set oRng = Range("Q1:Q" & lRow_last)
'''turn that range into a string
sValues = CStr(Join(Application.Transpose(oRng.Value2)))
lCount = Len(sValues)
lCount_After = lCount - Len(Replace(sValues, "St/", ""))
lCount_After = lCount_After / 3
Debug.Print lCount_After
Using ArrayToText() function
a) If you dispose of Excel version MS365 you can shorten a prior string building by evaluating the tabular ARRAYTOTEXT()
formula to get a joined string of all rows at once (complementing #Foxfire 's valid solution).
Note that it's necessary to insert the range address as string;
in order to fully qualify the range reference I use an additional External:=True argument.
b) VBA's Split() function eventually allows to return the number of found delimiters (e.g. "St/") via
UBound() function. It returns the upper boundary (i.e. the largest available subscript) for this
zero-based 1-dimensional split array.
Example: If there exist eight St/ delimiters, the split array consists
of nine elements; as it is zero-based the first element has index 0
and the last element gets identified by 8 which is already the wanted function result.
Function CountOccurrencies(rng As Range, Optional delim as String = "St/")
'a) get a final string (avoiding to join cells per row)
Dim txt As String
txt = Evaluate("ArrayToText(" & rng.Address(False, False, External:=True) & ")")
'b) get number of delimiters
CountOccurrencies = UBound(Split(txt, delim))
End Function
Not the cleanest one, but you can take all into arrays and split by St/. Size of that array would be how many coincidences you got:
Sub test()
Dim LR As Long
Dim MyText() As String
Dim i As Long
Dim q As Long
LR = Range("Q" & Rows.Count).End(xlUp).Row
ReDim Preserve MyText(1 To LR) As String
For i = 1 To LR Step 1
MyText(i) = Range("Q" & i).Value
Next i
q = UBound(Split(Join(MyText, ""), "St/"))
Debug.Print q
Erase MyText
End Sub
The output i get is 8
Please, note this code is case sensitive.
The TextJoin() function in Excel 2019+ is used:
Sub CalcSt()
Const WHAT = "St/": Dim joined As String
joined = WorksheetFunction.TextJoin("|", True, Columns("Q"))
Debug.Print (Len(joined) - Len(Replace(joined, WHAT, ""))) / Len(WHAT)
End Sub
I'm trying to send a post request to an API that takes an array of strings as an argument.
It comes out an error specifying that the types are not allowed and when the request is sent correctly all the data is left in the first position of the array (keyArray[0]).
The code I am using is the following:
Dim lastRow As Variant
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Dim vvArray As Variant
vvArray = Range("B12:B" & lastRow).Value
Dim vvArrayString() As String
ReDim vvArrayString(1 To UBound(vvArray))
For i = 1 To UBound(vvArray)
vvArrayString(i) = vvArray(i, 1)
Next
Dim TCRequestItem As Object
Set TCRequestItem = CreateObject("WinHttp.WinHttpRequest.5.1")
TCRequestItem.Open "POST", "url", False
TCRequestItem.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
TCRequestItem.send ("keyArray=" + vvArrayString)
I don't understand why you set vvArray and then vvArrayString? Why not go straight to vvArrayString by looping through column B?
Dim LastRow as Long
LastRow = Range("B" & Rows.Count).End(xlUp).Row
Dim vvArrayString(1 to LastRow-11)
For i = 12 to LastRow
vvArrayString(1-11) = Range("B" & i).text
Next
That should set the array correctly for you, you can then carry on to the next bit of code (the http request).
EDIT: the http request could also use a similar loop, as it's in such a simple repeating pattern. However you'd need a separate variable for it;
Dim strPostReq as String 'here's your separate variable
For x = 1 to LastRow-11
'Just add the same pattern to the end of the string each time
strPostReq = strPostReq & "keyArray[" & x-1 & "]=" & vvArrayString(x) & "&"
Next
'Then remove the last '&' from the string
strPostReq = Left(strPostReq, Len(strPostReq) - 1)
Then instead of the long previous string, you just do TCRequestItem.send(strPostReq)
It's my first time writing a code that actually attempts to do something and I'm having some trouble with writing an error handler. The code attempts to match 'tosearch' to the range I1:I10. If it finds a match and the cell is blank is asks for user input.
Obviously there is a problem in matching with loops as the loop will break at the slightest sniff of a mismatch. I attempted to solve this with the 'If iserror(etc.)' but I still get mismatch error type 13 and the debugger points me to this line
If IsError(myvalue = Application.Match(tosearch, Range("i1:i10"), 0)) Then
Please ignore the horrendous, sprawling mess beneath. It works (just) and while it doesn't have any practical use yet, i hope to use it to quickly identify matches between arrays but also have some control over whether the 'correct' match is displaying the right information.
If anyone has any answers your help would be hugely appreciated.
Dim myvalue As String
Dim myrng As Long
Dim tosearch As String
Dim myrnglimit As Long
Dim Uchoose As String
Dim animal As Variant
Dim blankchck As String
myrnglimit = 15
For myrng = 2 To myrnglimit
'isblank check
blankchck = Range("c" & myrng).Value
If blankchck = "" Then
'sets tosearch as each cell
tosearch = Range("a" & myrng).Value
'error checker then it matches each cell to the table hardcoded into the code
If IsError(myvalue = Application.Match(tosearch, Range("i1:i10"), 0)) Then
GoTo nextloop:
Else
myvalue = Application.Match(tosearch, Range("i1:i10"), 0)
'fills in the second column with Animal data
animal = Range("j" & myvalue).Value
Range("a" & myrng).Offset(0, 1).Value = animal
'User input for animal
Uchoose = MsgBox("Excel says : " & Range("k" & myvalue).Value & ". So are " & animal & " good?", vbYesNoCancel, "Status")
If Uchoose = vbYes Then
Range("a" & myrng).Offset(0, 2).Value = "Good"
ElseIf Uchoose = vbNo Then
Range("a" & myrng).Offset(0, 2).Value = "Bad"
ElseIf Uchoose = vbCancel Then
GoTo nextloop:
End If
'Select case to identify 1004 mismatch and skip
nextloop:
'Error checker if
End If
'Avoidblank if
End If
Next myrng
I think the problem may be caused because there is a difference between the data types in your range and the string variable toSearch. I'd recommend settting toSearch as follows:
Dim tosearch As Variant
The following link describes a similar problem and a similar solution to the one I have defined here.
http://www.excelforum.com/excel-programming-vba-macros/358571-application-match.html
I am trying to get some text between two words from a column of similar data, so far I have:
Dim I As Integer
For I = 1 To 989
thisSTRING = Worksheets(1).Range("A" & I).Value
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
Worksheets(1).Range("B" & I).Value = ref
Next I
The problem I have is that not all text in the column is the same and when I reach such a point in the for loop I get an error message as there is either no "RING" or "EM", to avoid this I tried to use "on error resume next". This worked but it duplicates in the cells which had the errors. Is there any simple method for making this skip the cell/leave it blank instead of creating a duplicate?
Here's what I was thinking:
Sub PrintSplit()
Dim ws As Excel.Worksheet
Dim i As Long
Dim thisSTRING As String
Dim ref As String
Set ws = ThisWorkbook.Worksheets(1)
For i = 1 To 989
thisSTRING = ws.Range("A" & i).Value
If InStr(thisSTRING, "RING ") > 0 And InStr(thisSTRING, " EM") > 0 Then
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
ws.Range("B" & i).Value = ref
End If
Next i
End Sub
This assumes that you want a blank if either of the strings are missing. If you only wanted it if both strings are missing the logic would be different, but similar.
Note that I changed i to a Long which is a good practice, as it's the native type for whole numbers and will accommodate larger values. I also created a worksheet variable, just to make it a little more flexible, and to get Intellisense.