View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Hans Hamm Hans Hamm is offline
external usenet poster
 
Posts: 41
Default Bottom Up search for multiple entries

On Tuesday, October 30, 2012 9:07:59 AM UTC-4, Hans Hamm wrote:
On Monday, October 15, 2012 7:43:16 AM UTC-4, Hans Hamm wrote:

On Friday, October 12, 2012 6:42:15 PM UTC-4, Ben McClave wrote:




Hans,
















I've modified this a bit to do this for you. Please note I haven't tested it. Let me know if you have any issues with it.
















Ben
















Sub ListPrograms()








Dim rCopy As Range 'Range of values to check








Dim rCopy2 As Range 'Blank cell at the top of an unused column








Dim x As Long 'Used for cycling through the rCopy2 range








Dim y As Long 'Used for cycling through the rPaste range








Dim rPaste(1 to 2) As Range 'First cell to receive the data
















'First, set up the copy from range and the copy/paste to range








'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow
















Set rCopy = Sheet3.Range("D2:D" & Sheet1.Range("D64000").End(xlUp).Row)








Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook








Set rPaste(1) = Sheet2.Range("A5")








Set rPaste(2) = Sheet2.Range("A36")
















y = 0 'Set to zero to start
















'Next, resize the rCopy2 range to match the rCopy range size and copy the data








Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)








rCopy.Copy rCopy2
















'Now, remove duplicates (assumes no headers)








rCopy2.RemoveDuplicates 1, xlNo
















'Once again resize rCopy2 to cover reduced data range








'**(Check next line to ensure that the sheet name and column are correct)








Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)
















'Now, cycle through each value in rCopy2 starting from the bottom _








and paste it to the final destination.








For x = rCopy2.Rows.Count To 1 Step -1








rPaste(1).Offset(y, 0).Value = rCopy2.Cells(x, 1)








rPaste(2).Offset(y, 0).Value = rCopy2.Cells(x, 1)








y = y + 1 'Increment y to ensure next value goes into the cell below








Next x
















'Finally, clear the rCopy2 range as it is no longer necessary.








rCopy2.Clear








Application.ScreenUpdating = True
















End Sub








Ah Ha! So, that is how you repeat a process with "Dim rPaste(1 To 2)" I could not figure out how to do that without repeating the entire process. Thanks! I am sure I will have additional questions for you when I hit the "wall" I do appreciate your help.




Ben, don't know if you are still seeing this, but I have a question for you. I am using (adapted a little) the code you provided in a different workbook and repeating the same process over and again looking for different information and it works to perfection! At the end of each section of code I need it to skip 2 rows and repeat the process (looking for different information from another column) How do I make this work?


I should have added; while most everything is working I am now trying to clean it up and automate more...