CODEWITHSUNDEEP
excelvba
Jacko058
Jacko058

Reputation: 69

Implement search box into current worksheet with macro

My macro currently works by pressing CTRL+F to open the search box which searches either REF1 or REF2. If the information is found, it copies over to the next cell basically to show it's there. If the information is not found, it pastes the data searched for in cell L4 so a label can be printed.

What I'm trying to do:

Remove the CTRL+F and basically run from a cell (let's say cell L18). However, when scanned the scanner basically types in the numbers then presses enter/return.

I was wondering, would it be possible to make it run like this.

Select cell L18 then keep scanning until either:
A) The list is done - nothing is missing
B) If REF1/REF2 doesn't match, pastes that data into cell L4 for a label to be printing.

(Current version using CTRL+F): http://oi39.tinypic.com/mima9x.jpg

(Example of what I need): http://oi42.tinypic.com/24fiwt1.jpg

Current macro:

    Sub Extra_Missing_Item()   Application.ScreenUpdating = False
   Dim rangeToSearch As Range
   With Sheets(1)
      Set rangeToSearch = .Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp).Row)
   End With


   Dim searchAmount As String
   searchAmount = InputBox("Scan the REF1 or REF2:")


   Dim cell As Range


   Set cell = rangeToSearch.Find(searchAmount, LookIn:=xlValues)
   With Sheets(1)
      If Not cell Is Nothing Then
        .Range("E" & cell.Row & ":G" & cell.Row).Value = _
           .Range("A" & cell.Row & ":C" & cell.Row).Value
      Else
MsgBox "REF1/REF2: " & searchAmount & " shouldn't be here"
        .Range("L4").Value = searchAmount
            Range("L9").Select
      End If
   End With


   Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 1058

Answers (1)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35853

I think I understand what you need. This macro calls each time any cell on the sheet changed (but if changed cell is not L18, macro do nothing):

Private Sub Worksheet_Change(ByVal Target As Range)

    If Application.Intersect(Target, Range("L18")) Is Nothing Then
        Exit Sub
    End If


    Dim rangeToSearch As Range
    Dim searchAmount As String
    Dim cell As Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set rangeToSearch = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)

    searchAmount = Target.value

    Set cell = rangeToSearch.Find(searchAmount, LookIn:=xlValues)
    If Not cell Is Nothing Then
        Range("E" & cell.Row & ":G" & cell.Row).value = _
        Range("A" & cell.Row & ":C" & cell.Row).value
    Else
        MsgBox "REF1/REF2: " & searchAmount & " shouldn't be here"
        Range("L4").value = searchAmount
    End If

    Range("L18").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Put this macro in the Sheet module (coresponding to the sheet where your data is):

enter image description here

Upvotes: 1

Related Questions