Transfer selected rows to sheet

--------------------------------------------------------------------------------

Dim MyValue As Variant
Dim FromSheet As Worksheet
Dim LookupColumn As Integer
Dim FromRow As Long
Dim FromColumn As Integer
'-
Dim ToSheet As Worksheet
Dim StartRow As Long
Dim LastRow As Long
Dim ActiveColumn As Integer
Dim ReturnColumnNumber
Dim ToRow As Long
Dim FoundCell As Object

'================================================= ============
'- MAIN ROUTINE
'================================================= ============
Sub DO_LOOKUP()
Application.Calculation = xlCalculationManual
'----------------------------------------------------------
'- LOOKUP SHEET [**AMEND AS REQUIRED**]
Set FromSheet = Workbooks("Book1.xls").Worksheets("MD")
LookupColumn = 2 ' look for match here
FromColumn = 2 ' return value from here
'-----------------------------------------------------------
'- ACTIVE SHEET
Set ToSheet = ActiveSheet
ActiveColumn = ActiveCell.Column
StartRow = ActiveCell.Row
'-------------------------------------------------------------
'- COMMENT OUT UNWANTED LINE, UNCOMMENT THE OTHER
'- ..............................[** FOR MULTIPLE ROWS **]
LastRow = ToSheet.Cells(65536, ActiveColumn).End(xlUp).Row
'-
'- ..............................[** FOR A SINGLE VALUE **]
' LastRow = ActiveCell.Row
'-------------------------------------------------------------
'- COLUMN NUMBER TO PUT RETURNED VALUE [**AMEND AS REQUIRED**]
ReturnColumnNumber = 2 ' column number
'-------------------------------------------------------------
'- loop through each row (which may be only 1)
For ToRow = StartRow To LastRow
MyValue = ToSheet.Cells(ToRow, ActiveColumn).Value
FindValue
Next
'-------------------------------------------------------------
'- finish
MsgBox ("Done")
Application.Calculation = xlCalculationAutomatic
End Sub
'== END OF PROCEDURE ==================================================
==

'=================================================
=======================
'- FIND VALUE
'=================================================
=======================
Private Sub FindValue()
' Dim VendMat As String
' Dim matDesc As String
' Dim startDate As String
' Dim BUN As String
Set FoundCell = _
FromSheet.Columns(LookupColumn).Find(MyValue, LookIn:=xlValues)
If FoundCell Is Nothing Then
MsgBox ("Material No. " & MyValue & " not found in Master List.")
'Paste this value to MD
'-----
' VendMat = Sheets("Sheet1").Select
' VendMat = Range("C65536").End(xlUp).Offset(0, 0).Select
'VendMat = Selection.Copy
'------

Sheets("MD").Select
Range("B:B").Select

Range("B65536").End(xlUp).Offset(1, 0).Select
IsEmpty (ActiveCell)
ActiveCell = MyValue

' Sheets("MD").Select
' Range("C:C").Select
' Range("C65536").End(xlUp).Offset(1, 0).Select
' IsEmpty (ActiveCell)
' ActiveCell.Select = VendMat
' ActiveCell = VendMat

'---------------------------------------------

Else
FromRow = FoundCell.Row
'- transfer additional data.
ToSheet.Cells(ToRow, ReturnColumnNumber).Value = _
FromSheet.Cells(FromRow, FromColumn).Value
End If
End Sub
'

This works fine in detecting and copying the new material number
accross to the master data sheet, but now i want it to copy the row in
which the new material number is located as there is other information
that goes with so it doesn't have to be manually typed in.

TIA


--
vect98
------------------------------------------------------------------------
vect98's Profile: http://www.excelforum.com/member.php...o&userid=26365
View this thread: http://www.excelforum.com/showthread...hreadid=399715

"vect98" wrote in
message ...

Transfer selected rows to sheet

Example:
You have data in A10:E20
You want to look for an item which can be located in
column A.
Suppose it's found at A12, then you want le entire
record A12:E12 be appended to the range K40:N120, at
the first free record, suppose K109:N109.
You want to have in the program the source range A10:E20
and the target range K40:N120 as code parameters.
Then for each operation you want to supply only the
item's name/code.

Is it ok?
Bruno

Bruno,

That 's the problem that i've met now - could you please write down
simple solution to the situation you mention?

Thanks,

Chri

--
chris10
-----------------------------------------------------------------------
chris100's Profile: http://www.excelforum.com/member.php...fo&userid=2516
View this thread: http://www.excelforum.com/showthread.php?threadid=39971

"chris100" wrote in
message ...

Bruno,

That 's the problem that i've met now - could you please write down a
simple solution to the situation you mention?

Here is quite a simple code.
Define how many columns involved (n), together with
source and target top left cells (SourceRange, TargetRange).
Let me know if you need any changes, or if you find
any bugs.

==========================================
Sub Button18_Click()
Dim SourceRange As Range, TargetRange As Range
Dim SearchRange As Range, LastWrittenCell As Range
Dim i, n As Integer, ItemToSearchFor
'--------------------------------------
' User definitions
n = 5 ' number of columns to append
Set SourceRange = [AA10]
Set TargetRange = [AG10]
'--------------------------------------
Set SearchRange = Range(SourceRange, SourceRange.End(xlDown))
Set LastWrittenCell = TargetRange.End(xlDown)

ItemToSearchFor = InputBox("Item To Search For:" & vbCrLf & "(case
sensitive)")
If ItemToSearchFor = "" Then
Exit Sub
End If

For Each i In SearchRange
If i.Value = ItemToSearchFor Then
Range(i, i.Offset(0, n - 1)).Copy LastWrittenCell.Offset(1, 0)
End If
Next

End Sub

==============================================

Bruno

Hi Bruno,

Thanks for the help but i'm afraid i didn't explain myself properly.
Cell A1 contains criteria i need to search for in Column L (This is a
date)
Any rows (say A to L row cells only) in Column L that contain the same
date as Cell A1 need to be copied and pasted to 'SheetArchive.'

I tried manipulating the code you gave but i'm afraid i'm not very good
at VBA for excel yet!

Thanks again for the help.


--
chris100
------------------------------------------------------------------------
chris100's Profile: http://www.excelforum.com/member.php...o&userid=25166
View this thread: http://www.excelforum.com/showthread...hreadid=399715

"chris100" wrote in
message ...

Hi Bruno,

Thanks for the help but i'm afraid i didn't explain myself properly.
Cell A1 contains criteria i need to search for in Column L (This is a
date)
[...]

Well, A1 contains the date you want to search for,
column L contains a lot of dates.

When the date is found in column L (say at L12),
the cells A12, B12, C12, ... need to be copied
to the same cells (A12, B12, C12,...) of 'SheetArchive'.
Is it ok?

Another question:
If date from A1 is found in column L at more then one
cell, must all ranges be copied to 'ArchiveSheet'?
Or, does column L contain unique values (i.e. no duplicates)?

Bruno