Search code examples
excelvba

Paste (dynamic) lookup formula in dynamic number of columns


I have sheets "2018" and "2019" which I created previously. 2019 only differs from 2018 in that it may have some rows added and/or some deleted.

Form cell "A3" and downwards I have skills listed and a "X" in the columns after if the person the column belongs to has this skill.

Now I need to fill the columns of 2019 with known X with formula below, first a bit of context code for the range selection part:

Dim rng As Range
Dim rngbegin As Range
Dim rngend As Range
Dim newrng As Range

Sheets("2018").Activate

   Set rng = Application.InputBox '...and rest of the code

rng.Copy
Sheets("2019").Range("B:B").Insert Shift:=xlToRight
       
Sheets(2019).Activate
Set rngbegin = rng.Cells(3, 1)
Set rngend = rng.Cells(3000, rng.Columns.Count)
Set newrng = Range(rngbegin.Address & ":" & rngend.Address)
newrng.ClearContents 'To clear everything in the defined range but the header rows

Here is the formula I could use if the columns wouldn't be varying:

 Range("B3").Select
 ActiveCell.Formula = "=IFERROR(LOOKUP(2,1/($A3='2018'!$A$3:D$5000),'2018'!$B$3:$B$5000),"")"
     Range("B2").AutoFill Destination:=Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)

The formula works but I have the following problems:

1 - Required: I can't hardcode the formula for every column because the number of columns may change (I store the number of columns as range var selected from the user via application.inputbox - that's how I inserted the columns in the new 2019 sheet)

2 - optional: I hardcoded the rows to a much higher number than are used because I didn't think of counting column A and then use the range.count.Address(?) as end of the search vector. Just came to my mind lol


Solution

  • You will probably need to tweak a few addresses. I left much of your code unchanged so you can easily adapt what I have came up with for your purposes.

    Sub Whatever()
    
    With Sheets("2018")
    
        ' Get the address of the old range, not used later in the macro
        iRows = .Cells(Rows.Count, 1).End(xlUp).Row
        iCols = .Cells(3, Columns.Count).End(xlToLeft).Column
        Set rngOld = Range(.Cells(3, 2), .Cells(iRows, iCols))
    
    End With
    
    With Sheets("2019")
    
        ' Get the address of the new range
        iRows = .Cells(Rows.Count, 1).End(xlUp).Row
        iCols = .Cells(2, Columns.Count).End(xlToLeft).Column
    
        Set rngNew = Range(.Cells(3, 2), .Cells(iRows, iCols))
    
        'Clear the new range
        rngNew.Clear
    
        ' Populate the formula
        ' Not very elegant, VBA solution would probably look nicer
        .Range("B3").Formula = "=IFERROR(if(LOOKUP(2,1/('2018'!$A$3:$A$" & iRows & " =$A3),'2018'!B$3:B$" & iRows & ")=""X"",""X"",""""),"""")"
    
        'Fill the formula
        Set rngTemp = .Range(.Cells(3, 2), .Cells(3, iCols))
        rngTemp.FillRight
        Set rngTemp = .Range(.Cells(3, 2), .Cells(iRows, iCols))
        rngTemp.FillDown
    
    End With
    
    End Sub