I'm trying to write a program in VBA for excel that will search through a column of "names", and if that name has the case-sensitive string "CAN" within it, then the column 6 columns over will be added to a total (canadaTotal). This is what I have so far... The problem is within the instr/isnumeric portion. I'm sure I'm using one of them incorrectly.. and if anybody could offer an alternative solution, or a quick fix, I would appreciate it.
(hint... I'm not sure if i can use my "search" variable as the second input of the instr function...)
Private Sub CommandButton5_Click()
Dim i As Integer
Dim col As Integer
Dim canadaTotal As Integer
Dim search As String
Dim canadaCheck As Long
i = 1
col = 4
canadaTotal = 0
Worksheets("sheet1").Activate
While Not Worksheets("Sheet1").Cells(i, col).Value = ""
search = Cells(i, col).Value
If IsNumeric(InStr(0, search, "CAN")) Then
canadaTotal = canadaTotal + Cells(i, col).Offset(0, 6).Value
End If
i = i + 1
Wend
MsgBox (canadaTotal)
End Sub
The problem you are having is that the Instr function starts with position 1, not position 0.
Also, Instr returns 0 if the string is not found, not a non-numeric value, so your test will always be true.
Additionally, the default for Instr is that it will not search case sensitive. In order to search case sensitive, you need to use the last "compare" parameter and set it to vbBinaryCompare.
Change this to:
If Instr(1, search, "CAN", vbBinaryCompare) <> 0 Then
and it should work.
Related
I want to find the text "General Account Section" using InStr and Excel's Search.
When I to use Excel's search and input the word "General" it finds the value.
When I try to search for "General Account Section" or "General " (General with a space after) it can't find the value.
The same goes with my InStr() function:
' Loop through entire column A
For i = 1 To eProColCount 'Rows.Count
If InStr(1, ActiveSheet.Cells(i, "A").value, "General") <> 0 Then
Debug.Print ActiveSheet.Cells(i, "A").value
End If
Next i ' End loop
When I copy the value inside the cell and paste it on the search or as a parameter on my InStr() it finds what I'm looking for.
I tried changing options inside the Excel's Search.
another way to read the column until it is not empty
Option Explicit ' it is a best practice
Sub search()
Dim n As Integer ' to read the next row
Dim myContent As String ' content of the current Cell
n = 1
Do While Not (IsEmpty(ThisWorkbook.Application.Sheets("NameOfMySheet").Cells(n, 1)))
myContent = ThisWorkbook.Application.Sheets("NameOfMySheet").Cells(n, 1).Value
If InStr(1, myContent, "General") <> 0 Then
Debug.Print myContent
End If
' next row
n = n + 1
Loop
End Sub
Here is the Data that i am trying to analyze:
As Shown in the picture, i am trying to match Column H with Column I. Any keyword match from Column H that matches in Column I would return a "1" and if no keyword matches it would return a "0".
I tried using Fuzzy Lookup, but am getting frustrated that it keeps giving me percentages and not a single 1 and 0. (true or false).
Is there anyway to do this with either a macro or equation or if someone could help me with Fuzzy Lookup too if that is a good solution as well.
Any help that could guide me in the right direction will help a lot.
Thanks!
Edit: (10/27/17)
UPDATE:
I have used this users answer here: https://superuser.com/a/984389/464791
It is really useful. But it still lacks what i believe every single excel user/dev needs, which is a string comparison in the way i describe above. I am still looking for a solution mainly so i can learn and that others in the future could have one. As of right now i don't need this solution anymore. But it is still something i would like to work on.
Fuzzy Lookup is intended to return a percentile to reference how close of a match it is. Please refer here
One option you could do is us the =IF() and have it display a 1 or 0 depending on how close of a match up it is.
ie. =IF( D1 >= .50 , 1 , 0) or =IF( D1 <= .50 , 0 , 1)
Try to use this code in a module... Use the variables to change the Worksheet name, the scanning location, the starting row and so on.
I tried to set most of them as you need it.
It just splits every string at their spaces maybe that can help you.
Option Explicit
Dim ws As Worksheet
Dim col1 As Integer
Dim col2 As Integer
Dim colFlag As Integer
Dim rowStart As Integer
Dim urWs1 As Long
Dim scanArr As Variant
Dim actScan As Variant
Dim i As Long
Sub test()
'Worksheet
Set ws = ThisWorkbook.Worksheets("Tabelle1")
'Column D = 4
colFlag = 4
'Column H=8
col1 = 8
'Column I=9
col2 = 9
'Start scanning
rowStart = 2
'Count Rows
urWs1 = ws.UsedRange.Rows.Count
For i = rowStart To urWs1
ws.Cells(i, colFlag).Value = 0
'Split at spaces
scanArr = Split(ws.Cells(i, col1).Value, " ")
For Each actScan In scanArr
If InStr(1, UCase(ws.Cells(i, col2).Value), UCase(actScan)) <> 0 Then
ws.Cells(i, colFlag).Value = 1
End If
Next actScan
'Opposite direction
scanArr = Split(ws.Cells(i, col2).Value, " ")
For Each actScan In scanArr
If InStr(1, UCase(ws.Cells(i, col1).Value), UCase(actScan)) <> 0 Then
ws.Cells(i, colFlag).Value = 1
End If
Next actScan
scanArr = ""
Next i
End Sub
/edit: uppercase comparison
My workplace is changing CMS systems and we have around 5,000 products to import. The problem comes with image URL formatting as the two systems are laid out vastly different. I need a function or VB code to convert one cell:
Main|1|Vaterra/VTR03014C-1.jpg;VTR03014C|2|Vaterra/VTR03014C-2.jpg;VTR03014C|3|Vaterra/VTR03014C-3.jpg;VTR03014C|4|Vaterra/VTR03014C-4.jpg;VTR03014C|5|Vaterra/VTR03014C-5.jpg;VTR03014C|6|Vaterra/VTR03014C-6.jpg;VTR03014C|7|Vaterra/VTR03014C-7.jpg;VTR03014C|8|Vaterra/VTR03014C-8.jpg;VTR03014C|9|Vaterra/VTR03014C-9.jpg;VTR03014C|10|Vaterra/VTR03014C-10.jpg;VTR03014C|11|Vaterra/VTR03014C-11.jpg;VTR03014C|12|Vaterra/VTR03014C-12.jpg;VTR03014C|13|Vaterra/VTR03014C-13.jpg;VTR03014C|14|Vaterra/VTR03014C-14.jpg
into two cells containing:
Vaterra/VTR03014C-1.jpg
and this is where it gets tricky:
Vaterra/VTR03014C-2.jpg;Vaterra/VTR03014C-3.jpg;Vaterra/VTR03014C-4.jpg;Vaterra/VTR03014C-5.jpg;Vaterra/VTR03014C-6.jpg;Vaterra/VTR03014C-7.jpg;Vaterra/VTR03014C-8.jpg;Vaterra/VTR03014C-9.jpg;Vaterra/VTR03014C-10.jpg;|Vaterra/VTR03014C-11.jpg;Vaterra/VTR03014C-12.jpg;Vaterra/VTR03014C-13.jpg;Vaterra/VTR03014C-14.jpg
Notice how the "Main|1|" has been removed also, the tricky part is that not all of these begin with or contain "Main|1|" and not all of the options begin with or contain "Vaterra".
The main steps would be to remove each image's suffixes and then capture the line of text up to ".jpg" and move it to a separate cell.
As you have VBA tag, here is a quickest VBA approach.
Assuming your your data is in column A starting from row 1 on sheet1.
This macro will write the below two lines in column B and C respectively.
Column B
Vaterra/VTR03014C-1.jpg
Column C
Vaterra/VTR03014C-2.jpg;Vaterra/VTR03014C-3.jpg;Vaterra/VTR03014C-4.jpg;Vaterra/VTR03014C-5.jpg;Vaterra/VTR03014C-6.jpg;Vaterra/VTR03014C-7.jpg;Vaterra/VTR03014C-8.jpg;Vaterra/VTR03014C-9.jpg;Vaterra/VTR03014C-10.jpg;|Vaterra/VTR03014C-11.jpg;Vaterra/VTR03014C-12.jpg;Vaterra/VTR03014C-13.jpg;Vaterra/VTR03014C-14.jpg
Here is the macro.
Public RegMatchArray
Sub test()
Dim sh As Worksheet
Dim rowCount As Long
Dim i, j As Integer
Dim strValue, strValue1, strValue2 As String
Set sh = Sheets("Sheet1")
rowCount = sh.Range("A1048576").End(xlUp).Row
For i = 1 To rowCount
strValue = sh.Cells(i, 1).Value
If InStr(1, strValue, "Main|1|") > 0 Then
strValue = Replace(strValue, "Main|1|", "")
End If
iPos = InStr(1, strValue, ";")
strValue1 = Left(strValue, iPos - 1)
strValue2 = Mid(strValue, iPos + 1, Len(strValue) - iPos - 1)
Call splitUpRegexPattern(strValue2, "([\w\s-]+?)\/([\w\s-]+?\.jpg)")
For j = LBound(RegMatchArray) To UBound(RegMatchArray)
If j < 1 Then
strValue2 = RegMatchArray(j)
Else
strValue2 = strValue2 & ";" & RegMatchArray(j)
End If
Next
sh.Cells(i, 2).Value = strValue1
sh.Cells(i, 3).Value = strValue2
Next
Set sh = Nothing
End Sub
Public Function splitUpRegexPattern(targetString, strPattern)
Dim regEx As New RegExp
Dim strReplace As String
Dim arrArray()
i = 0
'CREATE THE REGULAR EXPRESSION
regEx.Pattern = strPattern
regEx.IgnoreCase = True
regEx.Global = True
'PERFORM THE SEARCH
Set Matches = regEx.Execute(targetString)
'REPORTING THE MATCHES COLLECTION
If Matches.Count = 0 Then
RegMatchArray = ""
Else
'ITERATE THROUGH THE MATCHES COLLECTION
For Each Match In Matches
'ADD TO ARRAY
ReDim Preserve arrArray(i)
arrArray(i) = Match.Value
i = i + 1
Next
RegMatchArray = arrArray
RegExpMultiSearch = 0
End If
If IsObject(regEx) Then
Set regEx = Nothing
End If
If IsObject(Matches) Then
Set Matches = Nothing
End If
End Function
Note: You have to add "Microsoft VBSript Regular Expressions 5.5" reference by going into Tools -> References.
If you don't want to keep the original column A, change the below lines. This will delete the original data and give you the result in column A and B.
From:
sh.Cells(i, 2).Value = strValue1
sh.Cells(i, 3).Value = strValue2
To:
sh.Cells(i, 1).Value = strValue1
sh.Cells(i, 2).Value = strValue2
With some tweeks, you will be able to make it happen without VBA.
First, replace | and / with ; so that you can have a consistent delimiter.
Also, you can remove Main|1| by replacing it with empty space.
Now, choose Data => Text to Columns
Choose the option Delimeted
you can now use the delimeter semicolon and you will have data in separate cells with the as in each cell.
You can now remove unwanted entries.
As an alternate, here is a formula solution. Assuming the large single block of text is in cell A1, put this formula in cell B1 and copy down until it starts giving you errors:
=TRIM(MID(SUBSTITUTE("|"&$A$1,";",REPT(" ",LEN($A$1))),LEN($A$1)*(ROW(A1)-1)+1+LOOKUP(2,1/(MID(SUBSTITUTE("|"&$A$1,";",REPT(" ",LEN($A$1))),LEN($A$1)*(ROW(A1)-1)+ROW(INDIRECT("1:"&LEN($A$1))),1)="|"),ROW(INDIRECT("1:"&LEN($A$1)))),LEN($A$1)))
The errors mean that there are no more entries to return, so you can delete the cells with errors, and then select all the cells with the formula -> Copy -> Right-click -> Paste Special -> Values to convert them to just be text instead of formulas. (I highly recommend doing that because the Indirect function is volatile and can greatly slow down your workbook if you have many formula cells with it.)
Sub test1()
Dim Str As String
Dim Search As String
Dim Status As String
Str = Cells(2, 5).Value
Search = FDSA!Cells(2, 5).Value
Status = FDSA!Cells(2, 10).Value
If InStr(Search, Str) = True Then
Status = "ok"
Else
End If
End Sub
I will be building up from this with loops. I want to check if what is in Cells(2,5) is contained in FDSA!Cells(2,5). If it is true then I would like to mark FDSA!Cells(2,10) as ok. I am getting an object required message. This is what I could come up with after looking at examples and tutorials. Let me know if you have questions
Only second time working on VBA.
Thanks in advance, Alexis M.
Your syntax for referencing the worksheet is incorrect. That is probably throwing the error. You need to call to Worksheets("FDSA") and not use the FDSA! call like you have.
Also, you will have to set the cell value equal to Status for this to work. Just changing Status will not write it back into the workbook.
Also InStr returns the location of the match. If you want to know if there was a match, you need to check that the return is >0. This code should run and hopefully is closer to correct than your current code.
Sub test1()
Dim Str As String
Dim Search As String
Str = Cells(2, 5).Value
Search = Worksheets("FDSA").Cells(2, 5).Value
If InStr(Search, Str) > 0 Then
Worksheets("FDSA").Cells(2, 10).Value = "ok"
End If
End Sub
I have a simple problem that I'm hoping to resolve without using VBA but if that's the only way it can be solved, so be it.
I have a file with multiple rows (all one column). Each row has data that looks something like this:
1 7.82E-13 >gi|297848936|ref|XP_00| 4-hydroxide gi|297338191|gb|23343|randomrandom
2 5.09E-09 >gi|168010496|ref|xp_00| 2-pyruvate
etc...
What I want is some way to extract the string of numbers that begin with "gi|" and end with a "|". For some rows this might mean as many as 5 gi numbers, for others it'll just be one.
What I would hope the output would look like would be something like:
297848936,297338191
168010496
etc...
Here is a very flexible VBA answer using the regex object. What the function does is extract every single sub-group match it finds (stuff inside the parenthesis), separated by whatever string you want (default is ", "). You can find info on regular expressions here: http://www.regular-expressions.info/
You would call it like this, assuming that first string is in A1:
=RegexExtract(A1,"gi[|](\d+)[|]")
Since this looks for all occurance of "gi|" followed by a series of numbers and then another "|", for the first line in your question, this would give you this result:
297848936, 297338191
Just run this down the column and you're all done!
Function RegexExtract(ByVal text As String, _
ByVal extract_what As String, _
Optional separator As String = ", ") As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
Dim i As Long, j As Long
Dim result As String
RE.pattern = extract_what
RE.Global = True
Set allMatches = RE.Execute(text)
For i = 0 To allMatches.count - 1
For j = 0 To allMatches.Item(i).submatches.count - 1
result = result & (separator & allMatches.Item(i).submatches.Item(j))
Next
Next
If Len(result) <> 0 Then
result = Right$(result, Len(result) - Len(separator))
End If
RegexExtract = result
End Function
Here it is (assuming data is in column A)
=VALUE(LEFT(RIGHT(A1,LEN(A1) - FIND("gi|",A1) - 2),
FIND("|",RIGHT(A1,LEN(A1) - FIND("gi|",A1) - 2)) -1 ))
Not the nicest formula, but it will work to extract the number.
I just noticed since you have two values per row with output separated by commas. You will need to check if there is a second match, third match etc. to make it work for multiple numbers per cell.
In reference to your exact sample (assuming 2 values maximum per cell) the following code will work:
=IF(ISNUMBER(FIND("gi|",$A1,FIND("gi|", $A1)+1)),CONCATENATE(LEFT(RIGHT($A1,LEN($A1)
- FIND("gi|",$A1) - 2),FIND("|",RIGHT($A1,LEN($A1) - FIND("gi|",$A1) - 2)) -1 ),
", ",LEFT(RIGHT($A1,LEN($A1) - FIND("gi|",$A1,FIND("gi|", $A1)+1)
- 2),FIND("|",RIGHT($A1,LEN($A1) - FIND("gi|",$A1,FIND("gi|", $A1)+1) - 2))
-1 )),LEFT(RIGHT($A1,LEN($A1) - FIND("gi|",$A1) - 2),
FIND("|",RIGHT($A1,LEN($A1) - FIND("gi|",$A1) - 2)) -1 ))
How's that for ugly? A VBA solution may be better for you, but I'll leave this here for you.
To go up to 5 numbers, well, study the pattern and recurse manually in the formula. IT will get long!
I'd probably split the data first on the | delimiter using the convert text to columns wizard.
In Excel 2007 that is on the Data tab, Data Tools group and then choose Text to Columns. Specify Other: and | as the delimiter.
From the sample data you posted it looks like after you do this the numbers will all be in the same columns so you could then just delete the columns you don't want.
As the other guys presented the solution without VBA... I'll present the one that does use. Now, is your call to use it or no.
Just saw that #Issun presented the solution with regex, very nice! Either way, will present a 'modest' solution for the question, using only 'plain' VBA.
Option Explicit
Option Base 0
Sub findGi()
Dim oCell As Excel.Range
Set oCell = Sheets(1).Range("A1")
'Loops through every row until empty cell
While Not oCell.Value = ""
oCell.Offset(0, 1).Value2 = GetGi(oCell.Value)
Set oCell = oCell.Offset(1, 0)
Wend
End Sub
Private Function GetGi(ByVal sValue As String) As String
Dim sResult As String
Dim vArray As Variant
Dim vItem As Variant
Dim iCount As Integer
vArray = Split(sValue, "|")
iCount = 0
'Loops through the array...
For Each vItem In vArray
'Searches for the 'Gi' factor...
If vItem Like "*gi" And UBound(vArray) > iCount + 1 Then
'Concatenates the results...
sResult = sResult & vArray(iCount + 1) & ","
End If
iCount = iCount + 1
Next vItem
'And removes trail comma
If Len(sResult) > 0 Then
sResult = Left(sResult, Len(sResult) - 1)
End If
GetGi = sResult
End Function
open your excel in Google Sheets and use the regular expression with REGEXEXTRACT
Sample Usage
=REGEXEXTRACT("My favorite number is 241, but my friend's is 17", "\d+")
Tip: REGEXEXTRACT will return 241 in this example because it returns the first matching case.
In your case
=REGEXEXTRACT(A1,"gi[|](\d+)[|]")