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)
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 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.
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 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.
After hours of troubleshooting, I still cannot seem to find any good solution to this problem on my own. I've never done any VBA before, so this is mostly based on trial and error.
The function extractData_test() will define some variables, and then pass them on to other functions needed to do the work. There are still some more functions, but I've left them out, since they do not take any role in my issue.
I went for this solution since I need to do an extractData() for many, many sheets.
Function extractData_test()
'Define variables
Dim Token1 As String
Dim Token2 As String
Dim WSout As String
'Set attributes of the lines that should be returned, and to which worksheet.
Token1 = "TROLLEY"
Token2 = "TP"
WSout = "testWS2"
Sheets(WSout).Activate
Sheets(WSout).UsedRange.ClearContents
'Call Functions.FromRowNum //Line removed
Call exData(Token1, WSout, Functions.FromRowNum)
'Call Functions.FromRowNum //Line removed
Call exData(Token2, WSout, Functions.FromRowNum)
End Function
The function exData() will find lines in a source sheet that matches the criteria defined by the Token attribute. It will then copy the matching lines from the source sheet to the output sheet.
I need to call the exData() twice, with different parameter, since I need to match two different criteria. There could be several more calls on exData() too.
The problem arises when pasting on the second call. I have made a parameter "FromRowNum" that I want to pass into exData() when calling it. This parameter tells the function from which line it should start pasting. The FromRowNum function will just find the last row in ActiveSheet. But I'm not sure if I have got everything right.
Function FromRowNum()
Set WSout = ActiveSheet
With WSout
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
FromRowNum = LastCell.Row
End With
End Function
EDIT:
I forgot to describe what is actually happening.
All the functions run fine, and they give an output, but the output is wrong.
The first call of exData does what I expect. But on the second call, it will paste on row 1+NumberOfRowsInResult. In my test case this means that it will paste results from the second call from row 999. What I want to happen is to paste from the first empty row (after the first call is finished).
Here is the function exData().
Function exData(Tokens, WSoutX, FromRowNumParam) 'Changed from FromRowNum to FromRowNumParam
Dim WS As Worksheet
Dim LastCell As Range
Dim y As Long
Dim x As Long
Dim WSout As Worksheet
'PasteFromRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set WSout = Worksheets(WSoutX)
x = 0
xx = 0
n = 0
m = 0
rownumber = inf
Set WS = Worksheets("data")
With WS
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
y = LastCell.Row
End With
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split(Tokens, "|")
For Each cell In Sheets("data").Range("C:C")
x = x + 1
If x = y Then Exit For
For i = 0 To UBound(aTokens)
n = n + 1
If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
rownumber = x
Exit For
End If
Next
If rownumber = x Then Exit For
Next
For Each cell In Sheets("data").Range("C:C")
xx = xx + 1
If xx = y Then Exit For
For j = 0 To UBound(aTokens)
If InStr(1, cell.Value, aTokens(j), vbTextCompare) Then
m = xx
End If
Next
Next
numrows = m - rownumber
Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, numrows & ":" & numrows) 'Changed from FromRowNum to FromRowNumParam
End Function
SOLUTION
I implemented all the changes KazJaw suggested, and got further, though I still had some problems. Please see changes added to the previous code examples.
The line
Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, numrows & ":" & numrows)
had to be changed to
Sheets("data").Range(rownumber & ":" & rownumber, m & ":" & m).Copy Sheets(WSoutX).Range(FromRowNumParam& ":" & FromRowNumParam, FromRowNumParam+numrows & ":" & FromRowNumParam+numrows)
The end of the paste range was less than the start, causing problems. Therefore the need to add FromRowNumParam+numrows
First of all, your Function exData should be rather built as procedure Sub exData.
Second, you don't need to call this lines Call Functions.FromRowNum as it doesn't do anything. Returned function value isn't passed anywhere.
Third, to be sure you call correct function pass parameter to exData in this way:
Call exData(Token1, WSout, Functions.FromRowNum)
Forth, which could be biggest problem. You need to change FromRowNumber parameter in this line
Function exData(Tokens, WSoutX, FromRowNum)
to anything different like:
Function exData(Tokens, WSoutX, FromRowNumParam)
and change FromRowNum variable accordingly within the function. If not, each time you use FromRowNum variable within your function you rather call FromRowNum function instead of using value which was passed to the function.