Setting a range

[pnmng49]

Hi everyone,

Here is what I am trying to do:
Set a range to be from the first occurence of a value in col A to the last occurence of that same value in col A (offset three columns to the right).

I have started with code by Ron DeBruin found here:
http://msdn.microsoft.com/en-us/libr...omAllWorkbooks

The instructions say:
' Change this range to fit your own needs.

With mybook.Worksheets(1)
Set sourceRange = .Range("A1:C1")
End With

How do I change this if I need to merge from 10 workbooks and the sourceRange needs to be from the FirstOccurence in col A of a user input date to the LastOccurence in col A of that same user input date (offset 3 columns to right) ??

Thanks for the help.

[patel45]

attach please a sample file with current and desired situation

[HaHoBe]

Hi, pnmng49,

if you scroll down the link you provided you will find the solution for a range (given in the article itself):

f you want to copy from cell A2 until the last cell on the worksheet then replace this code with the following code. You might do this if there are headers in the first row.
Cc837974.note(en-us,office.12).gifNote:
If you use this procedure, copy the function RDB_Last into your code module.

First, add this line at the top of the macro.
VB

Dim FirstCell As String

Then add this code.
VB

With mybook.Worksheets(1)
FirstCell = "A2"
Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
' Test if the row of the last cell is equal to or greater than the row of the first cell.
If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
Set sourceRange = Nothing
End If
End With

Function RDB_Last is right above the link.

Does that solve your problem?
Holger

[pnmng49]

Thanks for the reply, but no that doesn't solve my problem.
There are 10 workbooks. The range will start and end at different cells for each workbook. The FirstOccurance and LastOccurance need to be found based on the user input date.

[HaHoBe]

Hi, pnmng49,

I donīt know the structure of your workbooks but you could either apply the Autofilter with the dates supplied (please mind that Dates need to be transferred by CLng to work) and then copy the visible cells into the new workbook or create a whole range like written in the article and then compare each single value from the Dates to your given data and build a new range to copy later on or copy directly.

If you need help with that please attach a sample workbook with some data as well as a copy of the destination workbook (if not a new one will be added).

Ciao,
Holger

[pnmng49]

TestAnn.xlsmTestCarmen.xlsmJacob.xlsmPassdown Test.xlsm

Thanks for the replies. I have attached three workbooks with test data and the workbook from which the merge should run. The desired result is that if a user inputs the date 5/1/12 the new worksheet should show all the rows from each workbook that have entries for 5/1/12. Can the filter be set from the workbook running the merge? Thanks

[HaHoBe]

Hi, pnmng49,

looking at your workbooks Iīd tend to copy all into a new workbook and filter there.

You need to adjust one line in the code as the first worksheet in every workbook seems to be "Logon" (change 1 to 2):

                ' Change this range to fit your own needs.
                With mybook.Worksheets(2)

Code to be used on the new workbook (macro recordings slightly worked on):

Sub FilterOnDate()
    With ActiveWorkbook.ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row) _
                , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1").CurrentRegion
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Range("B1")
        .Value = "Date"
        .Select
        .AutoFilter
    End With
    ActiveSheet.Range("$A$1:$E$1").AutoFilter Field:=2, Operator:= _
        xlFilterValues, Criteria2:=Array(2, "5/1/2012")
End Sub

Worked with Excel2007 on WinServer2003 for me.

Ciao,
Holger

[pnmng49]

Thanks HaHoBe,

It works great!

Thanks