User to select range to be used in a formula

mayhu372

New Member
Joined
Jul 13, 2020
Messages
8
Office Version
  1. 365
Platform
  1. Windows
hi! I am trying to add a formula in a sheet which requires the user to select a range of cells from a different file.
Both files might change name and format hence why I am using variable names.

I been braking my head and looking at old codes but I can't figure out what I am doing wrong. So any help would be amazing!!

VBA Code:
Sub macro42()
    
    Dim APOLD As Variant
    Dim APWBOLD As Workbook
    Dim APtEMPLATE As Variant 'open current AP (to be removed later)
    Dim APWB As Workbook 'open current AP (to be removed later)

        
'OPEN previous APWBOLD
                
            APOLD = Application.GetOpenFilename(fileFilter:="Excel Files (*.XLSx), *.XLSx", Title:="Select Previous version of AP")
            If APOLD = False Then Exit Sub
            Set APWBOLD = Workbooks.Open(APOLD)
            
 'select ranges in old APWBOLD
 
        Dim rngH As Range
        Dim rngAN As Range
        Dim rngData As Range
        Dim DefaultRange As Range
        

               
        'Get the headers range without the article number column
        
        If TypeName(Selection) = "Range" Then
        Set DefaultRange = Selection
        Else
         Exit Sub
        End If
          
          On Error Resume Next
            Set rngH = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select a the headers range excluding the article number column", _
              Default:=DefaultRange.Address, _
              Type:=8)
          On Error GoTo 0
        
        'Test to ensure User Did not cancel
          If rngH Is Nothing Then Exit Sub
  
        'Get the aricle number column range without the header row
          On Error Resume Next
            Set rngAN = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select a the Article number range excluding the headers row", _
              Default:=DefaultRange.Address, _
              Type:=8)
          On Error GoTo 0
        
        'Test to ensure User Did not cancel
          If rngAN Is Nothing Then Exit Sub
          
        'Get the headers range without the article number column
          On Error Resume Next
            Set rngData = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the data range excluding the headers row and the article number columns", _
              Default:=DefaultRange.Address, _
              Type:=8)
          On Error GoTo 0
        
        'Test to ensure User Did not cancel
          If rngData Is Nothing Then Exit Sub
  

            
'open current AP (to be removed later)
     
       
            APtEMPLATE = Application.GetOpenFilename(fileFilter:="Excel Files (*.XLSx), *.XLSx", Title:="Select Assortment NEW AP")
            If APtEMPLATE = False Then Exit Sub
            Set APWB = Workbooks.Open(APtEMPLATE)
            
'add formula in new AP

    Application.Calculation = xlManual

        APWB.Sheets("input").Range("BR12").Select
            ActiveCell.Formula2R1C1 = _
                "=IFERROR(XLOOKUP(R12C1,"rngH",XLOOKUP(R11C,"rngAN","rngData")),"""")"
                
          
        With APWB.Sheets("input")
            Range("BR12").Select
            Selection.Copy
            Range("BR12:DL13").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End With
        
        With APWB.Sheets("input")
            Range("BR12:DL13").AutoFill Destination:=Range("BR12:DL" & Range("A" & Rows.Count).End(xlUp).Row)
                        Range(Selection, Selection.End(xlDown)).Select
        End With
        
     
     Application.Calculation = xlAutomatic
            
 'close old file
 
 'APOLD.Close SaveChanges:=False
 

End Sub
 
You could use the type:=0 of the Application.InputBox

VBA Code:
Dim strDataAddress As String

APWB.Sheets("input").Activate

strDataAddress = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the data range excluding the headers row and the article number columns", _
              Default:=DefaultRange.Address, _
              [U]Type:=0[/U])
strDataAddress = Replace(strDataAddress, "=", vbNullString)

' (similarly for strHAdddress and strANAddress)

'...
ActiveCell.Formula2R1C1 = _
                "=IFERROR(XLOOKUP(R12C1," & strHAddress & ",XLOOKUP(R11C," & strANAddress & "," & strDataAddress & ")),"""")"

The Activate at the start is to cause the InputBox to return the approproriate workbook/worksheet referencing.
You could use the type:=0 of the Application.InputBox

VBA Code:
Dim strDataAddress As String

APWB.Sheets("input").Activate

strDataAddress = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the data range excluding the headers row and the article number columns", _
              Default:=DefaultRange.Address, _
              [U]Type:=0[/U])
strDataAddress = Replace(strDataAddress, "=", vbNullString)

' (similarly for strHAdddress and strANAddress)

'...
ActiveCell.Formula2R1C1 = _
                "=IFERROR(XLOOKUP(R12C1," & strHAddress & ",XLOOKUP(R11C," & strANAddress & "," & strDataAddress & ")),"""")"

The Activate at the start is to cause the InputBox to return the appropriate workbook/worksheet referencing.

Thanks for the feedback!
the Activate sheet is great! thanks for the idea! I needed that.

However, this one fails at the first StrDataAddress line.


VBA Code:
Sub macroAddFormula()
'add formula to extract data from the previous version of the Plan
 
 Dim APOLD As Variant
 Dim APWBOLD As Workbook
 Dim APtEMPLATE As Variant 'open current AP (to be removed later)
 Dim APWB As Workbook 'open current AP (to be removed later)

 
'OPEN previous version file APWBOLD
 
 APOLD = Application.GetOpenFilename(fileFilter:="Excel Files (*.XLSx), *.XLSx", Title:="Select Previous version of AP")
 If APOLD = False Then Exit Sub
 Set APWBOLD = Workbooks.Open(APOLD)
 
 'select ranges in previous version file APWBOLD
 
 Dim strDataAddress As String
 Dim strHAdddress As String
 Dim strANAddress As String
 

APWBOLD.Sheets("input").Activate


'Get the headers range without the article number column
 
strDataAddress = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the Article Number Column range excluding the headers row", _
              Default:=DefaultRange.Address, _
              Type:=0)
strDataAddress = Replace(strDataAddress, "=", vbNullString)


'Get the column range without the headers row
 
strHAdddress = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the Article Number Column range excluding the headers row", _
              Default:=DefaultRange.Address, _
              Type:=0)
strHAdddress = Replace(strHAdddress, "=", vbNullString)

'Get the data range without the headers row and article number column

strANAddress = Application.InputBox( _
              Title:="Extract From Previous AP", _
              Prompt:="Select the Article Number Column range excluding the headers row", _
              Default:=DefaultRange.Address, _
              Type:=0)
strANAddress = Replace(strANAddress, "=", vbNullString)

 
'open current AP (to be removed later)
 
 
 APtEMPLATE = Application.GetOpenFilename(fileFilter:="Excel Files (*.XLSx), *.XLSx", Title:="Select Assortment NEW AP")
 If APtEMPLATE = False Then Exit Sub
 Set APWB = Workbooks.Open(APtEMPLATE)
 
'add formula in new AP

 Application.Calculation = xlManual

 APWB.Sheets("input").Range("BR12").Select
 ActiveCell.Formula2R1C1 = "=IFERROR(XLOOKUP(R12C1,range(strHAdddress),XLOOKUP(R11C,range(strANAddress),range(strDataAddress))),"""")"
 
 
 With APWB.Sheets("input")
 Range("BR12").Select
 Selection.Copy
 Range("BR12:DL13").Select
 ActiveSheet.Paste
 Application.CutCopyMode = False
 End With
 
 With APWB.Sheets("input")
 Range("BR12:DL13").AutoFill Destination:=Range("BR12:DL" & Range("A" & Rows.Count).End(xlUp).Row)
 Range(Selection, Selection.End(xlDown)).Select
 End With
 
 
 Application.Calculation = xlAutomatic
 
 'close old file
 
 'APOLD.Close SaveChanges:=False
 

End Sub
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
How about
VBA Code:
                "=IFERROR(XLOOKUP(R12C1," & rngH.Address(, , xlR1C1) & ",XLOOKUP(R11C," & rngAN.Address(, , xlR1C1) & "," & rngData.Address(, , xlR1C1) & ")),"""")"
Also please acknowledge post#4

It works!!

Just added External = true

Thank you so much!!! :):):)
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

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