VBA: Replace Defined Range from Another Workbook with Dynamic

donatepresent

New Member
Joined
Oct 4, 2017
Messages
21
Hi Experts,

I'm trying to make my code more dynamic rather than static so, I want to replace the following code:

VBA Code:
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("Programs").Range("BD3:BD41").Copy .Range("BE3")
    OpenBook.Close False

Instead of defined 'Range("BD3:BD41")' in above OpenBook range, I want it to do the below code or better yet find the first column in the Pivot Table [in OpenBook.Sheets("Programs")] that contains "Grand Total" (would be in Row 4) and copy from that column from 'Row 3 to Row 41' and paste to ActiveWorkbook.Sheets("Sheet2") in BE3 or better yet the column right of the last column <-- see full code below:

VBA Code:
    Range("D4").Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(1, 1).Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range ("BE3")

Full code:
VBA Code:
    Application.AskToUpdateLinks = False
   
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
   
    With ActiveWorkbook.Sheets("Sheet2")
    MsgBox "Please select last month FS file"
   
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("Programs").Range("BD3:BD41").Copy .Range("BE3")
    OpenBook.Close False
   
      With .Range("D44", Cells(43, Columns.Count).End(xlToLeft).Offset(1))
         .FormulaR1C1 = _
           "=IFERROR(HLOOKUP(R[-38]C,'[FileToOpen]Programs'!R6C4:R41C55,36,FALSE),"""")"
         .Style = "Comma"
      End With
    End With
   
    Range("D43").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("D44").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
   
    Application.AskToUpdateLinks = True

Thanks :),
Ken
 
My test set up was running the code from the ActiveWorkbook, Opened second workbook with sheet named "Programs" and "Grand Total" in row 4 with arbirrary column.
The code ran without error and found "Grand Total", copied the rows 3:41 of that column to the next available column in Sheet 2 of the host workbook. So the code is doing what it was written to do. If you open the vb editor and use the F8 key to step through the code, with the editor screen diminished and positioned so you can see your worksheet, maybe you can spot where the problem is and we can then fix it. Right now, I have no clue.

Hi JLGWhiz,

I did a test with your code and it worked on another workbook and tried to figure why it doesn't work on this particular file.

I think the problem lies when it tries to find the last column with the "all the way to the right" code (Cells(3, Columns.Count).End(xlToLeft)) that it doesn't reach all the way to the right of Row 3 because there are gaps in the Pivot Table table so it stops in the Pivot Table and tries to paste into Pivot Table data which you cannot do and there's gaps in all rows of this Pivot Table so I cannot select another Row to use.

Is there a way around this like doing another Find on Row 4 for Grand Total of the ActiveWorkbook because the Grand Total would actually be the last column we are trying to arrive at and then offset to the right by 1 and paste the data there.

Line of code of referring to:
VBA Code:
        With OpenBook.Sheets("Programs")
             col = .Rows(4).Find("Grand Total", , xlValues, xlWhole).Column
             .Cells(3, col).Resize(39).Copy wb.Sheets(2).Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
        End With

Thanks,
Ken
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I am having difficulty understanding which sheets in which workbooks have pivot tables and which don't. I also do not understand what range of cells the pivot table(s) consume on the sheets.
 
Upvote 0
I am having difficulty understanding which sheets in which workbooks have pivot tables and which don't. I also do not understand what range of cells the pivot table(s) consume on the sheets.

Hi JLGWhiz,

They both are Pivot Tables. It is actually the same type of report. The OpenBook one is the prior month. The ActiveBook is the current month. I'm doing a variance analysis of the Grand Total from prior month Pivot Table to current Month Pivot Table.

The Pivot Table data is from Range("A3:BD41").Select on both WorkBooks , but this range can change month to month.

The ActiveBook worksheet is named "Sheet2" instead of "Programs" because the code hasn't named the the worksheet as "Programs" yet, so that's why it's referred to as "Sheet2".

Hope this is more clear now.

Regards,
Ken
 
Upvote 0
The only thing I see that might make a difference is in red font below. The paste part should not be affected by the tables, since the paste area would be outside the table.
Rich (BB code):
Set OpenBook = Application.Workbooks.Open(FileToOpen)
        With OpenBook.Sheets("Programs").ListObjects(1)
             col = .ListRows(4).Find("Grand Total", , xlValues, xlWhole).Column
             .ListCells(3, col).Resize(39).Copy wb.Sheets(2).Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
        End With
    OpenBook.Close False
 
Upvote 0
The only thing I see that might make a difference is in red font below. The paste part should not be affected by the tables, since the paste area would be outside the table.
Rich (BB code):
Set OpenBook = Application.Workbooks.Open(FileToOpen)
        With OpenBook.Sheets("Programs").ListObjects(1)
             col = .ListRows(4).Find("Grand Total", , xlValues, xlWhole).Column
             .ListCells(3, col).Resize(39).Copy wb.Sheets(2).Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
        End With
    OpenBook.Close False

Hi JLGWhiz,

Still no luck. Is using double Find not possible? It doesn't seem like it can find the last column of the table?

Thanks,
Ken
 
Upvote 0
Plsease post the full code you are using.
 
Upvote 0

Forum statistics

Threads
1,212,934
Messages
6,110,762
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top