Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

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

Status
Not open for further replies.

BetterBeef

Technical User
Aug 12, 2009
24
US
I set up the following macro to open up corresponding files and copy them into a worksheet.

Code:
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
 
Alright, I got it to work. I just pasted your code in verbatim. Instead I needed to add the "xlToLeft" instead of "xlLeft". I appreicate your help and will reward you with a star.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top