VBA detect and compare string - vba

I managed to get the answer after I run this code.
But I still received Runtime error 13 message. Can u help me to resolve it? #PEH
Dim ws As Worksheet
Dim str As String
str = "Attention for shipment on track"
Set ws = Worksheets("Report")
Dim lastrows As Long
lastrows = ws.cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 2 To lastrows
If InStr(1, ws.cells(i, 43).Value, str) > 0 Then
ws.cells(i, 63).Value = "OK"
End If
Next i

Note that InStr returns a position and not True or False what is needed for the If statement. Also "str" is litterally looking for these 3 characters "str" if you mean the variable str you need to remove the quotes here.
Finally the first parameter of the InStr function is the start position.
As #FunThomas pointed out in the comments the Start parameter in the beginning of the InStr function is optional and indeed can be omited.
Option Explicit
Sub track()
Dim str As String
str = "Attention for shipment on track"
Dim ws As Worksheet
Set ws = Worksheets("Report")
Dim lastrows As Long
lastrows = ws.cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 2 To lastrows
If InStr(1, ws.cells(i, 43).Value, str) > 0 Then
ws.cells(i, 63).Value = "OK"
End If
Next i
End Sub
Make sure always to use Option Explicit and declare all variables properly.

Related

why msg box is not working when i try to run a loop with VBA

I'm trying to run a loop to test if the length of strings in a column have at least ten characters. I debugged and there was no problem. However, I tested it with a string with less than 10 characters, the msg box wouldn't pop up. I am very new to VBA so could anyone please point out what my problem is? Thank you so much.
Sub MsgBoxforLenLessThanTen()
Dim wsData As Worksheet
Set wsData = Worksheets("Sheet1")
lastRow = ActiveSheet.UsedRange.Rows.count
Dim i As Integer
Dim length As Integer
i = 1
With wsData.Range("A1:A" & lastRow)
Do Until i > lastRow
length = Len(Range("A1").Offset(0, 1))
If length < 10 Then MsgBox "not enough characters"
i = i + 1
Loop
End With
End Sub
Please see below your corrected code, checking column "A" though. See comments for further details:
Option Explicit 'always use this, it will enforce you to declare your variables, which is well.. important.
Sub MsgBoxforLenLessThanTen()
Dim wsData As Worksheet
Set wsData = Worksheets("Sheet1")
Dim lastRow As Long 'Declare your variable
lastRow = wsData.UsedRange.Rows.Count 'You've declared your variable above for the sheet, use it
Dim i As Integer
Dim length As Integer
Dim msgValue As String: msgValue = "Not enough characters"
'try the for loop, is much easier
With wsData
For i = 1 To lastRow
length = Len(.Cells(i, "A"))
If length < 10 Then
'MsgBox msgValue
'Debug.Print msgValue & " at: " & .Cells(i, "A").Address
.Cells(i, "B").Value = msgValue
Else
'do something else
End If
Next i
End With
End Sub
EDIT: changed msgbox output to column B instead. I recommend you reading about the Immediate Window and Locals Window, they help massively in debugging your code, especially when you step through (F8).

Finding multiple words in excel and deleting row using vba

I tried creating my own script based on two scripts I found on stack but I can't make it seem to work. So what I'm trying to do is find certain words in my excel document and then delete the row that the data is on.
The pattern of the strings that I am looking for is eventually going to grow in time so I need to be able to update my array and have my vba script delete any row that matches my pattern.
Sub Deletrows_Click()
Dim WS As Worksheet
Dim pattern As String
Dim MyVar
For Each WS In ThisWorkbook.Worksheets
With WS
pattern = "string 1/ string 2/ string 3"
MyVar = Split(pattern, "/")
RowCount = ActiveSheet.UsedRange.Rows.Count
Dim i As Integer
For i = 2 To RowCount
Dim j As Integer
For j = 1 To 3 'find the word within this range
If Cells(i, j) = pattern Then
Cells(i, j).EntireRow.Delete
End If
Next j
Next i
End With
Next WS
End Sub
First, you have With WS but all your objects inside it are not referenced with that With statement, since your are missing the ..
So RowCount = ActiveSheet.UsedRange.Rows.Count should be RowCount = .UsedRange.Rows.Count. Also If Cells(i, j)... should be If .Cells(i, j)...
Second, a good way to check if a string in a certain cell is found within an array, in your case MyVar, which contains all your pattern, use the Match function:
If Not IsError(Application.Match(.Cells(i, j).Value, MyVar, 0)) Then
More explanations inside the code below:
Code
Option Explicit
Sub Deletrows_Click()
Dim WS As Worksheet
Dim pattern As String
Dim MyVar
Dim RowCount As Long, i As Long, j As Long
Dim DelRng As Range
' take it outside the loop, no need to re-create the array every time inside the loop
pattern = "string 1/ string 2/ string 3"
MyVar = Split(pattern, "/")
For Each WS In ThisWorkbook.Worksheets
With WS
RowCount = .UsedRange.Rows.Count
For i = 2 To RowCount
For j = 1 To 3 'find the word within this range
' you can use Match to see if cell's value is found within an array
If Not IsError(Application.Match(.Cells(i, j).Value, MyVar, 0)) Then
If Not DelRng Is Nothing Then
Set DelRng = Application.Union(DelRng, .Cells(i, j))
Else
Set DelRng = .Cells(i, j)
End If
End If
Next j
Next i
End With
' after looping through all cells, delete all rows with words in pattern at onc shot
If Not DelRng Is Nothing Then DelRng.EntireRow.Delete shift:=xlShiftUp
Set DelRng = Nothing ' reset range object
Next WS
End Sub

Find the texts in Dynamic Range in another sheet

I am creating a VBA application that will find the text that I have entered in a certain range (Should be dynamic, in order for me to input more in the future). With that the entered texts in the range will look for the words in another sheet column:
Example:
And it will look for the words inputted in another sheet.
Dim Main as Worksheet
Set Main = Sheets("Sheet1")
Dim Raw2 as Worksheet
Set Raw2 = Sheets("Sheet2")
LookFor = Main.Range(D8:100)
Fruits = Raw2.Range("G" & Raw2.Rows.Count).End(xlUp).row
For e = lastRow To 2 Step -1
value = Raw2.Cells(e, 7).value
If Instr(value, LookFor) = 0 _
Then
Raw2.Rows(e).Delete
Honestly I am not sure how to proceed. And the mentioned code is just experiment. Desired output is to delete anything in sheet2 except for the rows that contain the words that I have inputted in the "Look for the words". Hope you can help me. Thank you.
This should do the trick :
Sub Sevpoint()
Dim Main As Worksheet
Set Main = Sheets("Sheet1")
Dim Raw2 As Worksheet
Set Raw2 = Sheets("Sheet2")
Dim LooKFoR() As Variant
Dim LastRow As Double
Dim i As Double
Dim j As Double
Dim ValRow As String
Dim DelRow As Boolean
LooKFoR = Main.Range(Main.Range("G8"), Main.Range("G" & Main.Rows.Count).End(xlUp)).Value
LastRow = Raw2.Range("G" & Raw2.Rows.Count).End(xlUp).Row
For i = LastRow To 2 Step -1
ValRow = Raw2.Cells(i, 7).Value
DelRow = True
'MsgBox UBound(LooKFoR, 1)
For j = LBound(LooKFoR, 1) To UBound(LooKFoR, 1)
If LCase(ValRow)<>LCase(LooKFoR(j, 1)) Then
Else
DelRow = False
Exit For
End If
Next j
If DelRow Then Raw2.Rows(i).Delete
Next i
End Sub

Match in two different sheet and offset

I am writing the following code that finds a match from one worksheet (Sheet2) and pastes values into (sheet2).
So far the code targets those names that have "accepted" as offset values. it loops through looking for a match and displaying it. However i would like to also select the offset values and paste them in sheet1 if possible. THis is where I am getting confused please help, where to take my code from here?
Sheet1
Column a , b
5 Jim Accepted
6 Bob Rejected
7 Tim Accepted
Sheet 2
Column d e f g
Jim 40 0.4
Bob 78 58
Tim 36 45
Sub check()
Dim i As Long, lastrow As Long, myval As Long
Dim agentname As String
Dim sh2 As Worksheet
Dim val As String
Dim findstr As String
Dim rng As Range
Set sh2 = Sheets(2)
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
agentname = Cells(i, 1).Offset(, 1).Value
If Cells(i, 1) = "Accepted" And Not IsEmpty(Cells(i, 1)) Then
'For i = 1 To sh2.Range("b2:b9")
myval = Application.WorksheetFunction.Match(agentname, sh2.Range("b1:b9"), 0)
findstr = agentname
MsgBox agentname
End If
Next i
End Sub
Few problems -
agentname = Cells(i, 1).Offset(, 1).Value
This appears to be looking in the wrong column. It's returning "Accepted" or "Rejected" instead of the name. So remove the offset - you can specify what column you want directly, no need to offset. Keep it simple. (You don't even need the .Value, it's assumed)
agentname = Cells(i,1)
Now this is doubly confusing--
If Cells(i, 1) = "Accepted" And Not IsEmpty(Cells(i, 1)) Then
Again referring to the wrong column, we want column 2 here. And beyond that, if it is 'accepted', how could it also be empy? So we want:
If Cells(i, 2) = "Accepted" then
Ok, so next -
myval = Application.WorksheetFunction.Match(agentname, sh2.Range("b1:b9"), 0)
What is myval? Not a descriptive name, that can confuse you when you come back to your code. You're trying to match the agent name you saved, and specifying the range and sheet is on, that's great. Are the names really in column B? Without knowing the exact layout i'll assume they're on sheet 2 column A instead, that's easier for me. So now it's working when it finds a name, but a weird function of Worksheetfunction means it'll break if it can't find anything. So we'll wrap it in some error handling.
On Error Resume Next
myval = Application.WorksheetFunction.Match(agentname, sh2.Range("A1:A9"), 0)
If Err = 0 Then
findstr = agentname
MsgBox agentname
End If
On Error GoTo 0
I'm a little short on time, so a few more comments-
1.) You named your worksheet2 , that's fantastic. You should do it for worksheet1 too. In fact, go further and specify the workbook too. It'll save a lot of headache.
2.) You need to indent properly, maybe it just messed up when you posted here but those For loops and If statements need to be indented or you'll get a headache the next time you try to figure out what you were doing
3.) Use descriptive names, especially if you're writing a longer script that does a lot of things like this one.
4.) This is an opinion, but I think you should wait to declare your variables until you're about to use them. Again increased readibility. (And look into camel-Case for naming your variables, it's cosmetic, but...anyway I think it looks better)
Setup I was using - Sheet1:
A B
Tim Accepted
Tom Rejected
Sheet2:
A B C
Tim 40 30.1
Tom 21 15.5
Jeff 18 31.3
Code:
Sub check()
Dim sh1 As Worksheet: Dim sh2 As Worksheet
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Dim val As String
Dim findstr As String
Dim lastrow As Long
lastrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Dim i As Long
For i = 1 To lastrow
Dim agentname As String
agentname = sh1.Cells(i, 1)
If sh1.Cells(i, 2) = "Accepted" Then
On Error Resume Next
Dim myval As String
myval = Application.WorksheetFunction.Match(agentname, sh2.Range("A1:A9"), 0)
If Err = 0 Then
findstr = agentname
MsgBox agentname
End If
On Error GoTo 0
End If
Next i
End Sub
Instead of matching i have used the vlookup function this return the value in sheet2 matching the name on sheet1. This provides the basics of what I was trying to achieve. The code Acantud provided laid the foundation
Sub check()
Dim sh1 As Worksheet: Dim sh2 As Worksheet
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Dim val As String
Dim findstr As String
Dim lastrow As Long
lastrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
Dim i As Long
For i = 1 To lastrow
Dim agentname As String
agentname = sh1.Cells(i, 1)
If sh1.Cells(i, 2) = "Accepted" Then
On Error Resume Next
Dim myval As String
Dim myval1 As String
myval = Application.WorksheetFunction.VLookup(agentname, sh2.Range("A1:E13"), 3, False)
myval1 = Application.WorksheetFunction.VLookup(agentname, sh2.Range("A1:E13"), 5, False)
'Application.WorksheetFunction.Match(agentname, sh2.Range("A1:A9"), 0)
sh1.Cells(i, 3) = myval
' sh1.Cells(i, 4) = myval1
If Err = 0 Then
findstr = myval
End If
On Error GoTo 0
End If
Next i
End Sub

VBA column looping

I have a large Excel file and I need to replace all values in 12 columns completely.
Right now, there is a formula in each one of the cells, and I need to replace that formula with my own.
How do I loop through all those columns, knowing at what row it starts but don't know the end row (file is updated constantly). The hack of "A600000" seems overkill.
I am new to VBA and some guidance would be really appreciated.
ActiveSheet.UsedRange is the range of all the used cells on the current sheet.
You can use ActiveSheet.UsedRange.Rows.Count and .Columns.Count to get the height and widht of this range.
Here's a very crude function that hits every cell in the range:
Sub test()
Dim thisRange As Range
Set thisRange = ActiveSheet.UsedRange
With thisRange
For y = 1 To .Rows.Count
For x = 1 To .Columns.Count
thisRange.Cells(y, x).Value = "Formula here"
Next x
Next
End With
End Sub
But what you want may be different, can you be more specific?
The below will accomplish what you need to do. You just need to supply the startRow, .Sheets("Name"), and i arguments. If the columns are all the same length, then UsedRange will work fine if there are not random cells with values outside and below the columns you are interested in. Otherwise, try this in your code (on a throw away copy of your workbook)
Sub GetLastRowInColumn()
Dim ws as Excel.Worksheet
Set ws = Activeworkbook.Sheets("YOURSHEETNAMEHERE")
Dim startRow as long
startRow = 1
Dim lastRow as long
Dim i as long
For i = 1 to 12 'Column 1 to Column 12 (Adjust Accordingly)
lRow = ws.Cells(ws.Rows.Count, i).End(xlUp).Row
ws.Range(ws.Cells(startRow, i), ws.Cells(lRow, i)).Formula = "=Max(1)" 'Sample Formula
Next
End Sub
EDIT : Fixed typo
The below function will build the range with varying length columns. Use the function to return the desired range and fill all related cells in one shot.
Function GetVariantColumnRange(MySheet As Excel.Worksheet, _
TopRow As Long, StartColumn As Long, LastColumn As Long) As Excel.Range
Dim topAddress As String
Dim bottomAddress As String
Dim addressString As String
Dim i As Long
For i = StartColumn To LastColumn
topAddress = MySheet.Cells(TopRow, i).Address
bottomAddress = MySheet.Cells(MySheet.Rows.Count, i).End(xlUp).Address
addressString = addressString & ", " & topAddress & ":" & bottomAddress
Next
addressString = Right(addressString, Len(addressString) - _
InStr(1, addressString, ", ", vbBinaryCompare))
Set GetVariantColumnRange = MySheet.Range(addressString)
End Function
Usage follows...
Sub Test()
Dim myrange As Range
Set myrange = GetVariantColumnRange(ThisWorkbook.Sheets(1), 1, 1, 12)
myrange.Select 'Just a visual aid. Remove from final code.
myrange.Formula = "=APF($Jxx, "string1", "string2") "
End Sub