find row to use

M

Miree

I have a large excel data base, with an input sheet and storage sheet
each row in storgae has a unique number(at the moment i can only add then
next number)

I want to be able to user enter a number and pull the row out and put into
the entry page for editing.

Then to save over the previous data for that number with new edited data.

Thanks
 
P

Per Jessen

Hi

I think this will help you:

Sub FindNumber()
Dim Answer As Long
Dim TargetCol As String

TargetCol = "A"
Answer = InputBox("Enter number to find")

Set f = Columns(TargetCol).Find(what:=Answer)
If Not f Is Nothing Then
TargetRow = f.Row
Else
msg = MsgBox("Number " & Answer & " was not found")
Exit Sub
End If
End Sub

Regards,
Per
 
M

Mike H

Miree,

I assume your record number is in Column A sheet2 and you want to pull
records to Sheet1 to edit and then put then back. These 2 routines should do
that. Right click sheet1 tab, view code and paste this 2 subs in. I would run
them from a button on sheet 1

Sub PullItOut()
Dim MyRange As Range
Dim FoundIt As Boolean
FoundIt = False
Do
Response = InputBox("Enter record number to edit", vbOKCancel)
If Response = "" Then Exit Sub
If Not IsNumeric(Response) Or Response = 0 Then
MsgBox ("You must enter a number")
Else
Exit Do
End If
Loop
Response = Val(Response)
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet2").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value = Response Then
c.EntireRow.Copy
FoundIt = True
Exit For
End If
Next
If FoundIt Then
Range("A2").PasteSpecial
Else
MsgBox ("Record " & Response & " Not found")
End If
End Sub

Sub PutItBack()
Dim MyRange As Range
Dim FoundIt As Boolean
FoundIt = False
Record = Range("A2").Value
Rows(2).EntireRow.Copy
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet2").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value = Record Then
c.PasteSpecial
FoundIt = True
Exit For
End If
Next
If FoundIt Then
MsgBox ("Record replaced")
Rows(2).EntireRow.ClearContents

Else
MsgBox ("No corresponding record forund")
End If
End Sub

Mike
 
D

Dave Peterson

I wouldn't ask the user to type a number. I'd ask them to click a
cell/row/range.

dim myCell as range
dim myRow as long
set mycell = nothing
on error resume next
set mycell = application.inputbox(Prompt:="Select the row to process",type:=8)
on error goto 0

if mycell is nothing then
'user hit cancel, what should happen?
'exit sub '????
else
myrow = mycell.cells(1).row
...rest of code here
end if
 
M

Miree

Thanks this worked really well.

Mike H said:
Miree,

I assume your record number is in Column A sheet2 and you want to pull
records to Sheet1 to edit and then put then back. These 2 routines should do
that. Right click sheet1 tab, view code and paste this 2 subs in. I would run
them from a button on sheet 1

Sub PullItOut()
Dim MyRange As Range
Dim FoundIt As Boolean
FoundIt = False
Do
Response = InputBox("Enter record number to edit", vbOKCancel)
If Response = "" Then Exit Sub
If Not IsNumeric(Response) Or Response = 0 Then
MsgBox ("You must enter a number")
Else
Exit Do
End If
Loop
Response = Val(Response)
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet2").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value = Response Then
c.EntireRow.Copy
FoundIt = True
Exit For
End If
Next
If FoundIt Then
Range("A2").PasteSpecial
Else
MsgBox ("Record " & Response & " Not found")
End If
End Sub

Sub PutItBack()
Dim MyRange As Range
Dim FoundIt As Boolean
FoundIt = False
Record = Range("A2").Value
Rows(2).EntireRow.Copy
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet2").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value = Record Then
c.PasteSpecial
FoundIt = True
Exit For
End If
Next
If FoundIt Then
MsgBox ("Record replaced")
Rows(2).EntireRow.ClearContents

Else
MsgBox ("No corresponding record forund")
End If
End Sub

Mike
 
Top