Copying index formula to multiple data ranges - is it possible?

[montecristo]

Greetings all,

I am wondering if it is possible to apply an index formula across multiple ranges in a quick and easy way rather than having to copy and paste for every new range.

Below is an image of my spreadsheet:

I'm trying to create so automated way that I can apply the following index formula to each seperate range. The ranges vary in size to complicate things.

The formula column D is as follows:

=INDEX($E$2:$E$12,MATCH(B2,$A$2:$A$12,0))

Is there any way I can apply this to the red highlighted regions via VBA code?

I guess the code would have to identify the range each time and then loop, but this is way beyond my skills.

Any assistance would be greatly appreciated.

Cheers.

 

[JW00]

If your data is always separated by a single blank row & you are happy with a result in column D & not a formula, then you could use the following Sub.

Sub Iterate_IndexMatch()
Dim i As Long
Dim fr As Long, lr As Long

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Range("A2").Select

ReRun:

    fr = ActiveCell.Row
    lr = ActiveCell.CurrentRegion.End(xlDown).Row

    For i = fr To lr
        If Len(Range("D" & i)) > 0 Then
           GoTo Skip
        Else
           Range("D" & i) = WorksheetFunction.Index(Range("E" & fr & ":E" & lr), WorksheetFunction.Match(Cells(i, 2).Value, Range("A" & fr & ":A" & lr), 0))
        End If
    Next i
    
Skip:

    Range("A" & lr + 2).Select
    
    If Len(ActiveCell.Offset(1, 0)) > 0 Then
       GoTo ReRun
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
End Sub

 

[Fluff]

How about

Sub montecristo()
   Dim Rng As Range
   
   For Each Rng In Range("B:B").SpecialCells(xlConstants).Areas
      Rng.Offset(, 2).Formula = "=index(" & Rng.Offset(, 3).Address & ",match(" & Rng.Resize(1).Address(0, 0) & "," & Rng.Address & ",0))"
   Next Rng
End Sub

 

[montecristo]

If your data is always separated by a single blank row & you are happy with a result in column D & not a formula, then you could use the following Sub.


snip

Great work dude, that worked a treat. Many thanks.

 

[montecristo]

How about

Sub montecristo()
   Dim Rng As Range
  
   For Each Rng In Range("B:B").SpecialCells(xlConstants).Areas
      Rng.Offset(, 2).Formula = "=index(" & Rng.Offset(, 3).Address & ",match(" & Rng.Resize(1).Address(0, 0) & "," & Rng.Address & ",0))"
   Next Rng
End Sub

Fluff,
I'm keen to check if yours will work for me also as it keeps the formulas as well which is a possibly something I might need.

The only problem with your code is that it actually removes the 1st regions code and replaces it with the above (not a problem), except both the matching cell and matching column are being set as B:B. Is this fixable?

Thanks.

 

[JW00]

Montecristo, thanks for your kind words, but I think you should use Fluff's solution it is far more elegant, I tried it & if you replace 'Rng.Address' with 'Rng.Offset(, -1).Address' it will work perfectly for your needs.

Fluff, I hope you don't take offence at the correction to your typo, like I said I would use your solution, I just didn't know how to recommend it if it wasn't working as required.

 

[Fluff]

I hope you don't take offence at the correction to your typo, l

Definitely not, thanks for picking up on it.