Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
Hi Bruno, That's exactly what what trying to do...do you think you could write a simple code for that example that i can work with? Thanks a bundle 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? -- chris100 ------------------------------------------------------------------------ chris100's Profile: http://www.excelforum.com/member.php...o&userid=25166 View this thread: http://www.excelforum.com/showthread...hreadid=399715 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"chris100" wrote in
message ... Hi Bruno, That's exactly what what trying to do...do you think you could write a simple code for that example that i can work with? Yes, but tell me what/how many columns are involved and if there are duplicates values in column L. Bruno |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
Sorry - yep, there are 12 columns involved each containing differen info such as stock, cost price, market price, product name etc. O these 12 the only criteria is in column L. Column L contains differin dates for when a product arrived. The only info that needs to be copie are those pertaining to today() (which is in cell A1.) e.g PRODUCT PRICE STOCK DATE APPLE 1.50 15 01/09/05 BANANA 2.00 0 31/08/05 CRANBERRY 1.20 55 24/08/05 DILL 3.50 10 01/09/05 So in this example, assuming todays date (note there would be 8 mor columns in the middle) only the info for APPLE and DILL would b transferred over to the other worksheet. BANANA and CRANBERRY woul already have been transferred on the 31/08 nad 24/08 respectively. Let me explain what this is all for.... This forms part of a stock check and pricing system for a greengrocers Products come in, checked against bills and an invoice produced. Thi part of the system above will archive any purchases made so that ol bills could be checked. The reason i have to transfer over todays( info is so that the next day when a new item comes in, it forms th basis of the new price list. Hope that explains all this. I'm tryin to learn VBA but at the moment i'm just piecing together the syste with help from you guys (and gals). Who would have thought there wa so much to selling a pound of spuds.... -- chris10 ----------------------------------------------------------------------- chris100's Profile: http://www.excelforum.com/member.php...fo&userid=2516 View this thread: http://www.excelforum.com/showthread.php?threadid=39971 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
Hi all, I'm just bringing this up to the top of the list again because i really need help with this question. At the risk of sounding like i'm begging, please please please please with sugar on the top help! -- chris100 ------------------------------------------------------------------------ chris100's Profile: http://www.excelforum.com/member.php...o&userid=25166 View this thread: http://www.excelforum.com/showthread...hreadid=399715 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"chris100" wrote in
message ... Hi all, I'm just bringing this up to the top of the list again because i really need help with this question. At the risk of sounding like i'm begging, please please please please with sugar on the top help! Sorry for delay Chris, Try this sub and let me know if it's ok for you. You must define n (number of columns), SourceRange and TargetRange. It overwrites duplicates in TargetRange. If you have data in AA10:AE65536 and want to append the result of search to AG10:AK65536 you must state: n = 5 SourceRange = [AA10] TargetRange = [AG10] The routine will copy to AG10:AK65536 starting from the first empty cell in column AG10:AG65536 ======================================== Sub CopyRow() Dim SourceRange As Range, TargetRange As Range Dim SearchRange As Range, LastWrittenCell As Range Dim i, n As Integer, k 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)) If IsEmpty(TargetRange) Then Set LastWrittenCell = TargetRange k = 0 Else k = 1 If IsEmpty(TargetRange.Offset(1, 0)) Then Set LastWrittenCell = TargetRange Else Set LastWrittenCell = TargetRange.End(xlDown) End If End If 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(k, 0) End If Next End Sub ===================================== Ciao Bruno |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
Thanks for getting back bruno - i'll give that a go when i finish work and let you know. Regards, 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 |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
Hi Bruno, I've been playing around with the script and am very near a solution. The only change that's needed is to account for the same criteria appearing twice (i explian below). This is the slightly adjusted script: Sub CopyRow() Dim SourceRange As Range, TargetRange As Range Dim SearchRange As Range, LastWrittenCell As Range Dim i, n As Integer, k As Integer, ItemToSearchFor '-------------------------------------- ' User definitions n = 6 ' number of columns to append Set SourceRange = [AA1] Set TargetRange = Range("Sheet2!A1") '-------------------------------------- Set SearchRange = Range(SourceRange, SourceRange.End(xlDown)) If IsEmpty(TargetRange) Then Set LastWrittenCell = TargetRange k = 0 Else k = 1 If IsEmpty(TargetRange.Offset(1, 0)) Then Set LastWrittenCell = TargetRange Else Set LastWrittenCell = TargetRange.End(xlDown) End If End If ItemToSearchFor = [A1] 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(k, 0) End If Next End Sub The changes a Targetrange - adjusted to append to a different worksheet itemtosearchfor = A1 'where date(now) is used At the moment when there are several dates of the same value in the column, it will only append the last row of those dates. I need to append any rows which have the same date as cell A1. Could you please advise? I looked around but i'm afraid i don't know much about looping (and evidently everything else in VBA for that matter...) Regards, Chris -- chris100 ------------------------------------------------------------------------ chris100's Profile: http://www.excelforum.com/member.php...o&userid=25166 View this thread: http://www.excelforum.com/showthread...hreadid=399715 |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"chris100" wrote in
message ... [...] At the moment when there are several dates of the same value in the column, it will only append the last row of those dates. I need to append any rows which have the same date as cell A1. Could you please advise? I looked around but i'm afraid i don't know much about looping (and evidently everything else in VBA for that matter...) Regards, Chris Ok Chris, only slight modifications: added another counter (j) to the last For... Next. Please rerrange as per your need as I worked on my copy without following your modifications. -------------------------------------------- Sub CopyRow() Dim SourceRange As Range, TargetRange As Range Dim SearchRange As Range, LastWrittenCell As Range Dim i, n As Integer, k As Integer, j 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)) If IsEmpty(TargetRange) Then Set LastWrittenCell = TargetRange k = 0 Else k = 1 If IsEmpty(TargetRange.Offset(1, 0)) Then Set LastWrittenCell = TargetRange Else Set LastWrittenCell = TargetRange.End(xlDown) End If End If 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(k + j, 0) j = j + 1 End If Next End Sub ----------------------------------- Ciao Bruno |
#15
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"chris100" wrote in
message ... [...] At the moment when there are several dates of the same value in the column, it will only append the last row of those dates. I need to append any rows which have the same date as cell A1. Could you please advise? I looked around but i'm afraid i don't know much about looping (and evidently everything else in VBA for that matter...) Regards, Chris Ok Chris, only slight modifications: added another counter (j) to the last For... Next. Please rerrange as per your need as I worked on my copy without following your modifications. -------------------------------------------- Sub CopyRow() Dim SourceRange As Range, TargetRange As Range Dim SearchRange As Range, LastWrittenCell As Range Dim i, n As Integer, k As Integer, j 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)) If IsEmpty(TargetRange) Then Set LastWrittenCell = TargetRange k = 0 Else k = 1 If IsEmpty(TargetRange.Offset(1, 0)) Then Set LastWrittenCell = TargetRange Else Set LastWrittenCell = TargetRange.End(xlDown) End If End If 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(k + j, 0) j = j + 1 End If Next End Sub ----------------------------------- Ciao Bruno |
#16
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transfer selected rows to sheet
"chris100" wrote in
message ... [...] At the moment when there are several dates of the same value in the column, it will only append the last row of those dates. I need to append any rows which have the same date as cell A1. Could you please advise? I looked around but i'm afraid i don't know much about looping (and evidently everything else in VBA for that matter...) Regards, Chris Ok Chris, only slight modifications: added another counter (j) to the last For... Next. Please rerrange as per your need as I worked on my copy without following your modifications. -------------------------------------------- Sub CopyRow() Dim SourceRange As Range, TargetRange As Range Dim SearchRange As Range, LastWrittenCell As Range Dim i, n As Integer, k As Integer, j 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)) If IsEmpty(TargetRange) Then Set LastWrittenCell = TargetRange k = 0 Else k = 1 If IsEmpty(TargetRange.Offset(1, 0)) Then Set LastWrittenCell = TargetRange Else Set LastWrittenCell = TargetRange.End(xlDown) End If End If 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(k + j, 0) j = j + 1 End If Next End Sub ----------------------------------- Ciao Bruno |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
how do i transfer necessary rows/data from a master sheet | Excel Worksheet Functions | |||
how do i transfer necessary rows/data from a master excel sheet | Excel Worksheet Functions | |||
Transfer CELL value and spread it among 24 ROWs on another sheet | Excel Worksheet Functions | |||
Auto transfer rows from 1 sheet to another by account code. | Excel Worksheet Functions | |||
Automatically transfer selected data to another sheet on print | Excel Programming |