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
Related
image worksheetI am setting up sheet with hotels details and column "D" has hospitals that are close by eg PMH,SCGH,FSH. What i am trying to do is search column "D" based on a cell value on same sheet. I have code below but it will only do what i want if the cells in column"D" are single entry eg pmh. I need to be able to search all the cells in Column "D" for any instance of the text.
Many Thanks for any assistance
`Option Explicit
Sub finddata()
Dim hospitalname As String
Dim finalrow As Integer
Dim i As Integer
Sheets("Results").Range("A4:D100").ClearContents
Sheets("Main").Select
hospitalname = Sheets("Main").Range("g3").Value
finalrow = Sheets("Main").Range("A1000").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 4) = hospitalname Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Sheets("Results").Range("A4").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Main").Range("g3").Select
End Sub
`
The two simplest ways to do this would be
Using the Like operator:
If Cells(i, 4).Value Like "*" & hospitalname & "*" Then
This method has the drawback that a hospital name of, for instance, PMH might be matched against another one such as SPMH.
Using the InStr function:
If Instr("," & Cells(i, 4).Value & ",", "," & hospitalname & ",") > 0 Then
In this line, I "wrap" both the cell being looked at, and the value being searched for, within commas so it ends up searching for the string (for instance) ",PMH," within the string ",PMH,SCGH,FSH,". InStr will return the character position at which a match occurs, or zero if no match is found. So testing for > 0 is testing whether a match occurred.
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.)
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.
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
Need help in creating an Excel Macro.I have an Excel sheet.The Excel sheet is not consistent.
I am planning to make it uniform and structured.
Eg.
A B C D
1 test tester tester
2 hai test
3 Bye test tested
4 GN test tested Fine
A B C D
1 test testertester
2 hai test
3 Bye testtested
4 GN testtestedFine
Basically I have to find the last cell where element is placed so based on that I can write my CONCATENATE funciton.
In this case it would be Column D and hence my concatenate function would have been
=CONCATENATE(B1,C1,D1)
Again I would like the result to be in B1 but not a problem if I have to hide.
Can anyone help me in doing this?
You could use the following VBA function which joins (concatenates) the values from an arbitrary range of cells, with an optional delimiter.
Public Function Join(source As Range, Optional delimiter As String)
Dim text As String
Dim cell As Range: For Each cell In source.Cells
If cell.Value = "" Then GoTo nextCell
text = text & cell.Value & delimiter
nextCell:
Next cell
If text <> "" And delimiter <> "" Then
text = Mid(text, 1, Len(text) - Len(delimiter))
End If
Join = text
End Function
For an example of how to use the function, enter =JOIN(A1:D1) into a cell anywhere on the spreadsheet.
=B1&C1&D1
or
Adam's function that I have optimized.
Function Join(source As Range, Optional delimiter As String) As String
'
' Join Macro
' Joins (concatenates) the values from an arbitrary range of cells, with an optional delimiter.
'
'optimized for strings
' check len is faster than checking for ""
' string Mid$ is faster than variant Mid
' nested ifs allows for short-circuit
' + is faster than &
Dim sResult As String
Dim oCell As Range
For Each oCell In source.Cells
If Len(oCell.Value) > 0 Then
sResult = sResult + CStr(oCell.Value) + delimiter
End If
Next
If Len(sResult) > 0 Then
If Len(delimiter) > 0 Then
sResult = Mid$(sResult, 1, Len(sResult) - Len(delimiter))
End If
End If
Join = sResult
End Function