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
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
The code you posted does not make sense because after you copy and paste the column of data, the workbook is closed without saving. The code below will find "Grand Total" column and copy that column (rows 3:41) to the next available column of the same sheet, according to the sample code. But it will save the workbook upon closing.

VBA Code:
Dim Col As Long
 FileToOpen = Application.GetOpenFilename
 Set OpenBook = Application.Workbooks.Open(FileToOpen)
     With OpenBook.Sheets("Programs")
         Col = .Rows(4).Find("Grand Total", , xlValues, xlWhole).Row
         Cells(3, Col).Resize(39).Copy .Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
     End With
 OpenBook.Close True
 

donatepresent

New Member
Joined
Oct 4, 2017
Messages
21
The code you posted does not make sense because after you copy and paste the column of data, the workbook is closed without saving. The code below will find "Grand Total" column and copy that column (rows 3:41) to the next available column of the same sheet, according to the sample code. But it will save the workbook upon closing.

VBA Code:
Dim Col As Long
FileToOpen = Application.GetOpenFilename
Set OpenBook = Application.Workbooks.Open(FileToOpen)
     With OpenBook.Sheets("Programs")
         Col = .Rows(4).Find("Grand Total", , xlValues, xlWhole).Row
         Cells(3, Col).Resize(39).Copy .Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
     End With
OpenBook.Close True

Hi JLGWhiz,

There are two workbooks. I need this code to paste it to this workbook "ActiveWorkbook.Sheets("Sheet2")" after copying from OpenBook, that is why it is not saved because I am not saving the OpenBook workbook. Look at full code.

Thanks,
Ken
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Hi JLGWhiz,

There are two workbooks. I need this code to paste it to this workbook "ActiveWorkbook.Sheets("Sheet2")" after copying from OpenBook, that is why it is not saved because I am not saving the OpenBook workbook. Look at full code.

Thanks,
Ken
Try this.

VBA Code:
Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wb As Workbook, col As Long
    Set wb = ActiveWorkbook    
    MsgBox "Please select last month FS file"   
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)        
        With OpenBook.Sheets("Programs")
             Col = .Rows(4).Find("Grand Total", , xlValues, xlWhole).Row
             .Cells(3, Col).Resize(39).Copy wb.Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
        End With
   OpenBook.Close False
 

donatepresent

New Member
Joined
Oct 4, 2017
Messages
21

ADVERTISEMENT

Try this.

VBA Code:
Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wb As Workbook, col As Long
    Set wb = ActiveWorkbook  
    MsgBox "Please select last month FS file" 
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)      
        With OpenBook.Sheets("Programs")
             Col = .Rows(4).Find("Grand Total", , xlValues, xlWhole).Row
             .Cells(3, Col).Resize(39).Copy wb.Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
        End With
   OpenBook.Close False

Hi JLGWhiz,

I don't see the pasted data in ActiveWorkbook.Sheets("Sheet2") and it also makes this line of code not work (the With.Range):

VBA Code:
    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
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
That is because I left the sheet reference out. Replace this line:
VBA Code:
.Cells(3, Col).Resize(39).Copy wb.Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
With this line
VBA Code:
.Cells(3, Col).Resize(39).Copy wb.Sheets(2).Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
 

donatepresent

New Member
Joined
Oct 4, 2017
Messages
21

ADVERTISEMENT

That is because I left the sheet reference out. Replace this line:
VBA Code:
.Cells(3, Col).Resize(39).Copy wb.Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
With this line
VBA Code:
.Cells(3, Col).Resize(39).Copy wb.Sheets(2).Cells(3, Columns.Count).End(xlToLeft).Offset(, 1)
Hi JLGWhiz,

I tried a number of combinations with your suggested change and no luck. I still don't see the data getting pasted there and its still interfering with the other code.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
This is how the section of code you posted should now look.

VBA Code:
 Application.AskToUpdateLinks = False   
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wb As Workbook, col As Long
    Set wb = ActiveWorkbook
    With wb.Sheets("Sheet2")
    MsgBox "Please select last month FS file"   
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
        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
    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
 

donatepresent

New Member
Joined
Oct 4, 2017
Messages
21
This is how the section of code you posted should now look.

VBA Code:
 Application.AskToUpdateLinks = False
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wb As Workbook, col As Long
    Set wb = ActiveWorkbook
    With wb.Sheets("Sheet2")
    MsgBox "Please select last month FS file"
    FileToOpen = Application.GetOpenFilename
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
        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
    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
Copy and pasted exact and no luck. The macro runs without errors but doesn't do anything. It just did the formatting section and HLOOKUP (sometimes) and nothing for the find Grand Total in 4th row, offset to right 1 and copy and paste from row 3 to 41.
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,850
Messages
5,598,446
Members
414,240
Latest member
xnanx

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
Top