Form and Code to Find and Select a Range

[Mark F]

Hi all

I have a worksheet with around 8000 rows and 5 columns

I want the user to be able to type a 13 digit number into a form or entry box of some sort.

I then need the entered number to be "found" on the worksheet if it is present, and then columns A -E in the row that the number appears to be
selected and "copied". The copied info would then be manually pasted into another sheet.

If the number is not present in the sheet I would like an error message to appear.

Any suggestions where to start

Mark

 

[Ekim]

Mark,

Following assumptions made:
1. Your numbers and data on in Sheet1.
2. The data in Sheet1 starts in row 4, with headings in row 3.
3. The numbers are in column A (they do not have to be sorted).
4. Found items are to be copied to sheet3, starting in row 2 (headings in row 1).

The macro uses cell G1 as the input cell for your numbers. Simply input your number in cell G1, and then Enter. The row (columns A:E) will be copied to Sheet3 and cell G1 will be cleared for the next number. If no number is found, an error message will be returned. This is how I have set up my test data:

Find a serial number and copy row to new WS.xls
	A	B	C	D	E	F	G	H
1
2							xxxxxxxx
3	Number	Data2	Data3	Data4	Data5
4	1936140935	294	172	483	368
5	1051442260	127	299	397	332
6	1425768846	403	156	411	453
7	1687161648	116	231	358	231
8	1825868581	205	379	449	190
9	1066656755	342	342	145	481
10	1847317531	222	69	396	266
11	1716795218	51	97	265	314
12	1857161002	107	465	365	100
13	1389526819	369	439	303	157
14	1754217461	205	379	449	190
15	1381012033	165	212	359	157
16	1130503878	192	54	60	321
Sheet1

Put the macro in the sheet1 module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRange As Range
Dim ws As Worksheet
Dim res As Variant
Dim myVal As Long

Set ws = Sheets(1)

On Error GoTo xit

With ws
   Set myRange = .Range("A4", .Cells(.Rows.Count, "A").End(xlUp))
   myVal = Range("G1")
      
   If myVal = 0 Then Exit Sub
   res = Application.Match(myVal, myRange, 0)
      If IsError(res) Then
           MsgBox "Serial No. not found"
           Range("G1").ClearContents
      Else
        With myRange(res)
          .Resize(1, 5) _
          .Copy Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
        End With
      End If
   
Range("G1").ClearContents
End With
 
Set ws = Nothing
Set myRange = Nothing

Application.ScreenUpdating = True
xit:
Application.ScreenUpdating = True
Exit Sub
End Sub

HTH

Mike

 

[Mark F]

Mike

I am so sorry!!! You are 100% right

Please don't think I am not grateful for the time you took to reply and help although I would understand if you did

I appreciate any help I receive here.

Mark