VBA InStr with criteria in excel sheet

user_13762459 0
Viewed 104

I'm still a newbie working in VBA language. I need help on the InStr method, I trying to make my criteria in the excel sheet range.

Sub AddressCode()
Dim lastrow As Long
Dim i As Integer, icount As Integer

lastrow = ActiveSheet.Range("A30000").End(xlUp).Row
For i = 1 To lastrow
    If InStr(1, (Range("A" & i)), "Taman") <> 0 Then
        icount = icount + 1
        Range("H" & icount & ":L" & icount) = Range("A" & i & ":E" & i).Value
    End If
Next i
End Sub

Instr example

How can I list the result as my criteria and the result is offset from my row Address. For example, Column A : Alex is jogging at the park. Criteria list: Jogging, Running, Jumping and etc.

The Result will be Column A Alex is jogging at the park, and Column B Jogging

excel-formula vba excel
2 Answers

Copy Row Ranges with Criteria

A Quick Fix

Sub AddressCode()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim LastRow As Long: LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    ' Or:
    'LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    'LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    Dim i As Long, icount As Long
    
    ' The VBA constant 'vbTextCompare' means e.g. "Taman" = "TaMaN"
    ' The VBA constant 'vbBinaryCompare' means e.g. "Taman" <> "TaMaN"
    
    For i = 1 To LastRow
        If InStr(1, ws.Range("A" & i).Value, "Taman", vbTextCompare) > 0 Then
            icount = icount + 1
            ws.Range("H" & icount & ":L" & icount).Value _
                = ws.Range("A" & i & ":E" & i).Value
        End If
    Next i

End Sub

Ranges and Constants

  • The following illustrates how easy it can be to make it work for other values of the constants. Play with them, but be careful: there is no undo.
Sub AddressCodeRangeAndConstants()
    
    Const sFirst As String = "A1"
    Const sCriteria As String = "Taman"
    Const dfirst As String = "H1"
    Const nCols As Long = 5
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim slCell As Range
    Set slCell = ws.Cells(ws.Rows.Count, ws.Range(sFirst).Column).End(xlUp)
    Dim srg As Range: Set srg = ws.Range(sFirst, slCell)
    
    Dim drg As Range: Set drg = ws.Range(dfirst).Resize(, nCols)
    
    Dim sCell As Range
    For Each sCell In srg.Cells
        If InStr(1, sCell.Value, sCriteria, vbTextCompare) > 0 Then
            drg.Value = sCell.Resize(, nCols).Value
            Set drg = drg.Offset(1)
        End If
    Next sCell

End Sub
user_98140690

Change your line to following should work, if not found will return -1:

When start pos is stated , then compare type is compulsory

If InStr(1, Range("A" & i), "Taman",vbTextCompare) >0 Then

Or the following is working also:

If InStr(Range("A" & i), "Taman") > 0 Then
user_158978610
Related