I have a TextBox and ListBox. I want to find a string in a range containing specific multiple words (keywords) written in TextBox and display it in the ListBox
For example:
I have a string a = "Sun is shinning"
And I want to research the range, find and display cell value containing these specific words when I write in TextBox for example "sun shinning".
Take a look into my last string where I write word "sun" in lowercase.
I wrote the code
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
' For x = 0 To UBound(z)
If ws.Range("E" & i) Like AAA
.Value & "*" Then
.AddItem ws.Range("D" & i)
.column(1, ZZZ.ListCount - 1) = ws.Range("E" & i)
'.column(2, ZZZ.ListCount - 1) = ws.Range("E" & I)
End If
' Next x
Next i
End With
End Sub
But each time when I try to add second loop responsible for splitting the sentence and loop by each word I get an error message.
Have you got any idea how to simply modify my code to do that?
Assuming multiple words entered into textbox AAA are always entered with spaces, this procedure works (tried and tested).
The procedure uses the Split function to load the word(s) in the AAA textbox into an array, then loops the array for each cell.
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
Dim sWords() As String, x As Integer
sWords = Split(AAA.Value, " ")
For x = 0 To UBound(sWords)
If ws.Range("E" & i) Like "*" & sWords(x) & "*" Then
.AddItem ws.Range("D" & i)
.Column(1, Sheet1.ZZZ.ListCount - 1) = ws.Range("E" & i)
End If
Next x
Next i
End With
End Sub
As I type this I had the thought that it may be even faster to loop the array once and Find any matches of each word in the entire range, but I will leave that up to you.
Related
New working on VBA with excel. Learning on my own and happy this community exist.
I am working on picking information from a string within a cell in excel.
Example:
cell value: Make.Model.Issuer
I'm trying to read any set of characters using the "." as limits.
read from right till "."
read between "."
read from left till "."
Thank you all in advance :)
The following code will generate an array with the picked words:
Dim s As String
Dim a As Variant
s = "Make.Model.Issuer"
a = Split(s, ".")
MsgBox a(0) & " " & a(1) & " " & a(2)
I'm not sure what you're doing with the extracted strings so I'm going to place them in cells.
This will iterate down column A and place the split string into as many columns as it needs to in the same row.
Dim strarr As Variant
Dim i As Long
Dim lr As Long
Dim j As Long
With Sheet1 'Change as needed
lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Change the 1 to whatever your column is
For i = 1 To lr
strarr = Split(.Cells(i, 1).Value, ".") 'Change the 1 to whatever your column is
For j = LBound(strarr) To UBound(strarr)
.Cells(i, 1).Offset(, j + 1).Value = strarr(j)
Next j
Next i
End With
i would like to come up with vba sub that searching value from one specified cell (job) across all sheets and then pastes rows but only with selected columns. If value not found any error message instead paste value.
I know it's bigger project but I'm fresh so try to my best.
As far i have solution for whole rows:
Sub TEST()
Dim tws As String
Dim l_row As String
Dim l_rowR As String
Dim job As String
Dim i As Integer
Set tws = ThisWorkbook.Sheets("Data")
tws.Range("A20") = "STATS:"
job = tws.Range("B5")
lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Worksheets("Sheet1").Range("E" & i).Value = job And _
Worksheets("Sheet1").Range("D" & i).Value = "x2" Then
Worksheets("Sheet1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i
End Sub
I have written a code which gives me the errors (if any cell is non numeric) in a separate sheet called "Error_sheet".
But the output is a bit clumsy as it gives me non numeric cell address in a confusing fashion. Like the errors will not be pasted one after another. There will be some blanks in between if there are more than one non Numeric cells.
Sub Test()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If IsNumeric(Range("A" & i).Value) Then
Else
Sheets("Error").Range("A" & Row).Value = "Error in" & i & " row of ColumnNAme"
Row = Row + 1
End If
Next i
End Sub
It gives me output like shown below but can I get the output like Error in 7,14 rows of column name in a desired cell of "Error_sheet".
[![Output][1]][1]
[1]: https://i.stack.imgur.com/JqXwq.png
My understanding of what you've written is that you want something like this.
Option Explicit
Sub Test()
' Unqualified book/sheet below, means code will always run the isnumeric check on the cells of the active sheet. Is that what you want? '
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Index as long
Dim i As Long
Dim NonNumericRows() as string
Redim NonNumericRows(1 to lastrow)
For i = 2 To LastRow
If not(IsNumeric(Range("A" & i).Value)) Then
Index = index + 1
NonNumericRows(Index) = cstr(i)
End if
Next i
Redim preserve NonNumericRows(1 to index)
Sheets("Error").Range("A1").Value = "Error in row(s): " & strings.join(nonnumericrows,", ") & " of ColumnNAme"
End Sub
Hope it works or helps.
Like QHarr suggested, using Option Explicit is normally a good idea, and try not to use VBA operators as variables.
Also when working with more than 1 sheet, its best to define each in the code. I dont know what your first sheet is called, so please change the line: Set shSource = Sheets("Sheet1") to suit:
Option Explicit
Sub SubErrorSheet()
Dim lr As Long, i As Long
Dim shSource As Worksheet, shError As Worksheet
Set shSource = Sheets("Sheet1")
Set shError = Sheets("Error")
lr = shSource.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lr
If Not IsNumeric(shSource.Range("A" & i).Value) Then
shError.Range("A" & Rows.count).End(xlUp).Offset(1, 0).Value = "Error in row " & i & " of ColumnNAme"
End If
Next i
End Sub
Hi I'm a bit new to vba so I will try to explain my problem as far as possible.
I have a dataset in Excel in Column A, I have a lot of file names like this:
1. AB000**1234**45.tif
2. AB000**1235**45.tif
3. AB000**1236**45.tif
4. AB000**1237**45.tif
etc..
From this I want to take out all the strong characters and put in column C so it will look like this:
1. 1234
2. 1235
3. 1236
4. 1237
etc..
At the moment I have a code that looks like this:
Sub TakeOut
Dim str1 As String
Dim LR As Long
Dim cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
For Each cell In RNG
L = Len(RNG)
If L > 0 Then
RNG = ...
End If
Next cell
Range("C:C").Columns.AutoFit
End Sub
I have tried to count left(5) and right(6) but don't know how to take out the 4 character that I want.
Hope you can help me with this.
If you want to take out the strong characters from the string. Try it below. It will take all the Bold Characters in a cell and place it in C column.
Hope you are looking for this?
Sub get_bold_content()
Dim lastrow, i, j, totlength As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
totlength = Len(Range("A" & i).Value)
For j = 1 To totlength
If Range("A" & i).Characters(j, 1).Font.Bold = True Then
outtext = outtext & Range("A" & i).Characters(j, 1).Text
End If
Next j
Range("C" & i).Value = outtext
outtext = ""
Next i
End Sub
Take a look at the Mid() Function link.
usage in your case:
Mid(cell.Value, 6, 4) 'First parameter is the string, 6 is the start character, 4 is length
The easiest way without looping would be something like this:
Sub TakeOut()
Dim rng As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rng.Offset(, 1) = Evaluate("IF(" & rng.Address & "="""","""",MID(" & rng.Address & ",6,4))")
End Sub
Looking for help regarding writing a loop that will combine all the text values in a column while adding "OR" in between each one. To give some context, I have filenames stored in a column and I want to write a macro that will combine all those filenames separated by "OR" so I can copy and paste the string into a windows search bar and find all those files in a folder.
For example (in Column A)
Apples
Oranges
Bananas
Pears
Blueberries
In B1, the result should be Apples OR Oranges OR Bananas OR Pears OR Blueberries.
While learning to use For and Do loops in VBA is an essential skill, you will find that looping over ranges of cells is slow, and often too slow to be useful. There is often an alternative, and in this case it's the Join function:
Function MergeColumn(rng As Range, Delimiter As String) As Variant
MergeColumn = Join(Application.Transpose(rng.Columns(1).Value), Delimiter)
End Function
How this works:
It's a UDF, so it can be called from other VBA code, or from a worksheet cell
You pass it a Range object. It processes only the left most column of that Range
rng.Columns(1).Value returns the left most column, as a 2D Variant Array, size n x 1 where n is the number of rows in rng. That is, its dimension is 1 to n, 1 to 1
Application.Transpose transposes the array. It has the added feature that when passed a n x 1 array it returns a 1D array length n. That is, its dimension is 1 to n
Join concatenates each member of the array, inserting Delimiter between each element.
Use it like this
In VBA
Sub Demo
Dim r as Range
Dim strResult as String
' Get a reference to the range to be processed, eg
Set r = Range("A1:A10")
' Call the function
strResult = MergeColumn(r, " OR ")
' Print Result to Imedieate window
Debug.Print strResult
End Sub
As a cell formula
=MergeText(A1:A10," OR ")
here is a simple example using For Each Loop
Dim cel as Range, rng as Range
Set rng = Range("A1","A5")
For Each cel in rng
With Range("B1")
If .Value = "" Then
.Value = cel
Else
.Value = .Value & "OR" & cel
End If
End With
Next
Using simple For Loop:
Dim rng as Range, i as integer
Set rng = Range("A1", "A5")
For i = 1 to rng.Rows.Count
With Range("B1")
If .Value = "" Then
.Value = rng.Range("A" & i)
Else
.Value = .Value & "OR" & rng.Range("A" & i)
End If
End With
Next
Using Do Loop
Dim rng as Range, i as integer
Set rng = Range("A1", "A5")
i = 1
Do Until i > rng.Rows.Count
With Range("B1")
If .Value = "" Then
.Value = rng.Range("A" & i)
Else
.Value = .Value & "OR" & rng.Range("A" & i)
End If
End With
i = i + 1
Loop
Hope this helps.
With a formula (assuming Apples is in A2 and B1 is blank):
=IF(ISBLANK(B1),A2,B1&" OR "&A2)
copied down to suit (and output in last row).
A simple solution. Feel free to modify the code.
I did not include much flexibility such as count last row.
Just a basic template to show you how to use for loop.
for li_row = 1 to 10
if str_file = '' then
str_file = cells(li_row,1).value
else
str_file = str_file + ' OR ' + cells(li_row,1).value
end if
next
cells(1,2).value = str_file
One more method ..it works upto last used row in column A
Tested
Sub testing()
Dim lrow As Integer
Dim erange As Range
Dim str As String
With ActiveSheet
lrow = .Range("A" & Rows.Count).End(xlUp).Row
str = ""
For Each erange In .Range("A2:A" & lrow)
If str = "" Then
str = erange.Value
Else
str = str & " OR " & erange.Value
End If
Next erange
MsgBox (str)
End With
End Sub