CODEWITHSUNDEEP
vbaexcel
wittman
wittman

Reputation: 305

Modify macro for column search

I have a macro that until now was used just to search one cell from column F but now I must search for all the cell in column F. If value from F is found in range N:AN, offset(f,0,1) must have the cell value (found row , column AI).

Sub find()
    Dim FindString As String
    Dim Rng As Range
    FindString = Sheets("Sheet1").Range("f48").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("n:an")
            Set Rng = .find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Sheets("Sheet1").Range("f48").Offset(0, 1).Value = Rng.Offset(0, 21).Value
            Else
                Sheets("Sheet1").Range("f48").Offset(0, 1).Value = "Nothing found"
            End If
        End With
    End If
End Sub

Upvotes: 0

Views: 62

Answers (2)

Doug Coats
Doug Coats

Reputation: 7117

See if this is helpful. Its a bit of a change but I think it may be cleaner :)

Of course you need to adjust it for your offset criteria once you "find" a match in the N:NA range

Sub Dougsloop()

Dim rCell As Range
Dim rRng As Range
Dim wsO As Worksheet
Dim aRR As Variant

Set wsO = ThisWorkbook.Sheets("Sheet1")

aRR = wsO.UsedRange.Columns("N:NA")

Set rRng = ThisWorkbook.Sheets("Sheet1").Range("F1:F500")
For Each rCell In rRng.Cells
    If Trim(rCell.Value) <> vbNullString Then
        thisValue = rCell.Value
        If IsError(Application.Match(aRR, thisValue, 0)) = True Then
            'Generic Eror Handling
        ElseIf IsError(Application.Match(aRR, thisValue, 0)) = False Then
            'Stuff you do when you find the match
            rCell.Offset(0, 1).Value = "found it"
        End If
    End If
Next rCell

End Sub

Upvotes: 1

SJR
SJR

Reputation: 23081

Perhaps this, if I understand correctly (it does assume the value in F will only be found once at most).

Sub find()

Dim Rng As Range
Dim r As Range

With Sheets("Sheet1")
    For Each r In .Range("F1", .Range("F" & .Rows.Count).End(xlUp))
        If Trim(r) <> vbNullString Then
            With .Range("n:an")
                Set Rng = .find(What:=r.Value, _
                                LookAt:=xlWhole, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    r.Offset(0, 1).Value = .Cells(Rng.Row, "AI").Value
        'Else
        '    Sheets("Sheet1").Range("f48").Offset(0, 1).Value = "Nothing found"
                End If
           End With        
        End If
     Next r
End With

End Sub

Upvotes: 1

Related Questions