Use a Macro to Select a Range based on blank cells 1

[BetterBeef]

I set up the following macro to open up corresponding files and copy them into a worksheet.

Sub Run_Hedges()
'
' Run_Hedges Macro
' Macro recorded 3/15/2010 by Chris Vesta
'
' Keyboard Shortcut: Ctrl+h
'
    Range("B4:AT150").Select
    Selection.ClearContents
    Range("B4").Select
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 1.xls"
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Windows("hedging week 1.xls").Activate
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Windows("hedging week 1.xls").Activate
    Range("A7:E48").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("hedging week 1.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 2.xls"
    Range("A7:E49").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("hedging week 2.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 3.xls"
    ActiveWindow.SmallScroll Down:=1
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("L4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q4").Select
    Windows("hedging week 3.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 4.xls"
    Range("A7:E48").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=10
    Windows("hedging week 4.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 5.xls"
    Range("A7:E49").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("V4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AA4").Select
    Windows("hedging week 5.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 6.xls"
    Range("A7:E48").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=13
    Windows("hedging week 6.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 7.xls"
    Range("A8:E45").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("AF4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("hedging week 7.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 8.xls"
    Range("A7:E36").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("AK4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("hedging week 8.xls").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:= _
        "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week 9.xls"
    Range("A7:E36").Select
    Selection.Copy
    Windows("WEEKLY HEDGING (CRV).xls").Activate
    Range("AP4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("hedging week 9.xls").Activate
    ActiveWindow.Close
    ActiveWindow.SmallScroll ToRight:=-23
    Range("A9").Select
    ActiveWorkbook.Save
End Sub

As you can see this code is fairly repetitive. In fact it repeats itself 9 times for 9 separate files. There are two modifications to this code that I would like to do, but am unsure of how to do it.

The first modification is that I would like the macro to select data from each hedging week file (ex: "hedging week #.xls) starting with A7 and ending with E? where ? is the last cell in column E prior to a blank cell. So for example, if E7 through E49 has data but E50 does not, I would want the macro to select A7 through E49.

The issue is that each hedging sheet has a different number of rows that have data and unfortunately data exists in further rows in the same columns (from the previous example, more information starts in row 51). So if I select the entire column, I will pull in data that will mess up my template.

The second modification I want to make is that when this macro closes a file that I have used to copy information from, I get a message that says, "There is a large amount of information on the Clipboard. Do you want to be able to paste this information into another program later?"

I would like to be able to disable this message so that the macro simply runs without prompting the user to do anything. The answer for each one of these prompts, should be "no".

If you need any further clarification, please do not hesitate to ask. I appreciate everyone's help on this!

Thanks,
Chris

 

[SkipVought]

Hi,

I would like to be able to disable this message...

Use Application.DisplayAlerts = FALSE

Regarding Q1, it is not very clear.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

mybe this???

Sub Run_Hedges()
    Dim i As Integer, ws As Worksheet, wsCOPY As Worksheet
    
    Set ws = ActiveSheet
    ws.Range("B4:AT150").ClearContents
    
    For i = 1 To 9
        Set wsCOPY = Workbooks.Open(Filename:= _
            "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week " & i & ".xls")
        wsCOPY.Range("A7:E48").Copy
        ws.[IV4].End(xlLeft).PasteSpecial xlPasteValues
    Next
    
    Application.DisplayAlerts = False
    ws.Parent.Save
    Application.DisplayAlerts = True
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

Skip,

Your answer for question 2 was perfect! Thank you very much for that. Let me try to clarify question 1.
Each workbook ("hedging week ?.xls" where ? is 9 different files from 1 to 9) has data to be copied starting with A7 and ending with column E. The last row to be copied depends on how many consecutive rows there are without a blank cell. Each of these files has a different number of data points (rows) so I cannot simply set a pre-defined range to copy. The code must start with A7 and copy over to column E and stop at the row before the next blank cell in Column E.

I can send you sample data so you can see what I mean. Hedging Week 1.xls may have 48 rows of data to copy, but Hedging Week 2.xls may have 40 rows of data to copy. I need a dynamic macro that will be able to copy only what is needed.

Please let me know if you need any further clarification.

Thanks,
Chris

 

[BetterBeef]

One more clarification: The Range used in my code, ("A7:E49") was only an example of a range of what that particular file would use. This needs to be replaced by the "dynamic code" that I was referring to in the previous post.

Also, I tried running the code that you gave me, but I got a type mismatch error on the following code:

Set wsCOPY = Workbooks.Open(Filename:= _
"I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week " & i & ".xls")

Let me know your thoughts.

Thanks,
Chris V.

 

[SkipVought]

how about this...

Sub Run_Hedges()
    Dim i As Integer, ws As Worksheet, wsCOPY As Worksheet, rng As Range
    
    Set ws = ActiveSheet
    ws.Range("B4:AT150").ClearContents
    
    For i = 1 To 9
        Set wsCOPY = Workbooks.Open(Filename:= _
            "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week " & i & ".xls")
        Set rng = wsCOPY.Range("A7:E7")
        wsCOPY.Range(rng, rng.End(xlDown)).Copy
        ws.[IV4].End(xlLeft).PasteSpecial xlPasteValues
    Next
    
    Application.DisplayAlerts = False
    ws.Parent.Save
    Application.DisplayAlerts = True
    
    Set rng = Nothing
    Set wsCOPY = Nothing
    Set ws = Nothing
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

Skip, you Dim wsCopy As Worksheet but try to set it to a Workbook object, thus the the type mismatch error.

 

[SkipVought]

...oops

    For i = 1 To 9
        Set wsCOPY = Workbooks.Open(Filename:= _
            "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week " & i & ".xls")[b].ActiveSheet[/b]
        Set rng = wsCOPY.Range("A7:E7")
        wsCOPY.Range(rng, rng.End(xlDown)).Copy
        ws.[IV4].End(xlLeft).PasteSpecial xlPasteValues
    Next

VERY sorry!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

Now I am getting an error on the following line:

ws.[IV4].End(xlLeft).PasteSpecial xlPasteValues

"Run-time error '1004':
Application-defined or object-defined error"

I made the changes that you and PHV recommended.

 

[SkipVought]

ws.[IV4].End(xl[b]To[/b]Left).PasteSpecial xlPasteValues

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

OK, I ran the code and the good news is that there are no more errors. The bad news is that the code doesn't do quite what I had anticipated.

If you look at my original code, the first week should be pasted at cell B4, not A4. Week 2 is pasted in G4, Week 3 in L4, etc... Also, I need each file that is opened to be closed as well as shown in the previous code. Unfortunately I am not quite up to speed on VBA and did a lot of the code by creating a macro using the recorder.

Any help you can give me would be very much appreciated.

Thanks!
Chris V.

 

[SkipVought]

Sub Run_Hedges()
    Dim i As Integer, ws As Worksheet, wsCOPY As Worksheet, rng As Range
    
    Set ws = ActiveSheet
    ws.Range("B4:AT150").ClearContents
    ws.[A4] = "X"
    
    For i = 1 To 9
        Set wsCOPY = Workbooks.Open(Filename:= _
            "I:\Beef\Pricing\Erika\Reports\Balance Forward\hedging week " & i & ".xls").ActiveSheet
        Set rng = wsCOPY.Range("A7:E7")
        wsCOPY.Range(rng, rng.End(xlDown)).Copy
        ws.[IV4].End(xlLeft).PasteSpecial xlPasteValues
        wsCOPY.Parent.Close
    Next
    ws.[A4].ClearContents
    
    Application.DisplayAlerts = False
    ws.Parent.Save
    Application.DisplayAlerts = True
    
    Set rng = Nothing
    Set wsCOPY = Nothing
    Set ws = Nothing
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Just an observation based on experience and deduction.

You are copying 5 columns from 9 workbooks, I assume have identical structure.

Then you string these out horizontally. I see problem with this step. You have 9 sets of data, uneven blocks of data, AWFUL! You will have all sorts of problems USING this data sucessfully and to Excel's full potential using this structure.

Rather, it would seem to me that the data would be better structured in 6 columns, the sixth identifying the SOURCE workbook (1-9) With a structure like this, ALL your column data is of the same kind, not spread all over the sheet. Excel was made to handle this kind of structure, NOT the one your currently have.

Or am I missing something?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

Skip,

Normally I would completely agree with you! However, the sole purpose for this exercise is to dump data so that I can use it to run a pivot table. The number of rows varies each week because the number of unique products that are sold varies each week. Once the data is in the spreadsheet, everything else works out pretty well.

 

[BetterBeef]

Skip,

For some reason when I run the code now, it still is pasting the information into column A, even though you placed a "X" there to prohibit this from happening. I am getting data pasted into A4 down the entire A column, which of course messes up the sheet.

Any thoughts? By the way, I really appreciate your help and patience on this one. This is something one of our employees would have to do by hand, and it will save us a lot of time. I will then go through the code and analyse it to understand how the code does what it does.

Thanks so much!

 

[SkipVought]

However, the sole purpose for this exercise is to dump data so that I can use it to run a pivot table.

So how does your structure help? My experience with pivot tables strongly dictates otherwise!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

There is an intermediary step which is done via VLOOKUP on all of the products that are dumped, which makes compiles all the data from the dump. The VLOOKUP table then has a Pivot run on it. Unfortunately, I was not the one that created this table. I am just trying to set up some code so that the person pasting in the information doesn't have to copy and paste 9 times.

Any clue why the information is getting pasted into A4 even though you placed an "X" there to force the paste into B4?

 

[SkipVought]

        ws.[IV4].End(xlLeft)[B].Offset(0, 1)[/B].PasteSpecial xlPasteValues

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[BetterBeef]

I'm so sorry, Skip, but I got a run-time error of '1004': Application-defined or object-defined error. I replaced the old ws.[IV]... code with what you posted up above and got that error. I apologize if this is getting frustrating...

 

[SkipVought]

If you did this instead, it would be ready to PIVOT, assuming that your table has proper headings in row 3 AND you did not need a source reference...

        ws.[B65536].End(xlUp).Offset(1).PasteSpecial xlPasteValues

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}