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...
|