Excel macro to search for value in a column and return a value on the same row from another column in message box

StackOverflow https://stackoverflow.com/questions/23396423

  •  13-07-2023
  •  | 
  •  

Вопрос

I am trying to write a macro that will prompt the user to enter a value and do the following:

- Search for the value in column B and select the first cell where the value is found
- Return the correspondong value in column L and M of the selected cell's row within a message box
- Then once the user hits "ok", the macro will find and select the next cell in column B with the search criteria, and repeat the above steps
- Once all of the cells with the search criteria in column B have been searched and found, a message box will communicate that all matches have been found and close loop 

Below is the code I have started out with, and being a beginner with VB, I can't figure out why my loop isn't working correctly... Please help!

    Sub Macro1()
Dim response As String, FndRow As Long, NoMatch As Boolean, LastRow As Long
response = InputBox("Please enter the Column Name to find matching Source File Field Name.")
If response = "" Then Exit Sub
On Error Resume Next
Range("B5").Select
NoMatch = False
LastRow = 0
Do Until NoMatch = True
    FndRow = Cells.Find(What:=response, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Row
    If FndRow = 0 Then
        MsgBox response & " could not be found."
        NoMatch = True
    ElseIf FndRow < LastRow Then
        MsgBox "All " & response & " matches have been found."
        NoMatch = True
    Else
        Range("B" & FndRow).Select
        MsgBox "Source File Name: " & Range("L" & FndRow).Value & vbNewLine & "File Column Name: " & Range("M" & FndRow).Value
        LastRow = FndRow
    End If
Loop
End Sub
Это было полезно?

Решение

I would use a filter instead of a find loop:

Sub tgr()

    Dim rngVis As Range
    Dim VisCell As Range
    Dim sFind As String

    sFind = InputBox("Please enter the Column Name to find matching Source File Field Name.")

    If Len(Trim(sFind)) = 0 Then Exit Sub   'Pressed cancel

    Application.ScreenUpdating = False
    With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("B"))
        .AutoFilter 1, sFind
        On Error Resume Next
        Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        .AutoFilter
    End With
    Application.ScreenUpdating = True

    If rngVis Is Nothing Then
        MsgBox sFind & " could not be found."
    Else
        For Each VisCell In rngVis.Cells
            MsgBox "Source File Name: " & VisCell.Worksheet.Cells(VisCell.Row, "L").Text & vbNewLine & _
                   "File Column Name: " & VisCell.Worksheet.Cells(VisCell.Row, "M").Text
        Next VisCell
    End If

End Sub

Другие советы

your Find is acting strangely because you are looking for match 'horizontally'. You need to use SearchOrder:=xlByColumns

FndRow = Cells.Find(What:=response, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top