How to tell macro to perform Match, Index formula using another cell with Match, Index data?

1
votes

I have an Excel workbook with 2 master sheets and one data entry sheet.

Project Master:

|Project No  |Asset No    |
|------------|------------|
|P01         |A01         |

Asset Master:

|Asset No   |Description   |
|-----------|--------------|
|A01        |Testing       |

For my data entry sheet, I want to use Project No as my reference and use Index/Match formula in VBA to search for the other 2 fields. In this case:

|Project No  |Asset No   |Description  |
|------------|-----------|-------------|
|P01         |A01        |Testing      |

I also want the data entry sheet to only change the selected row instead of refreshing the entire sheet whenever I change a single cell. So in VBA data entry sheet I used the code:

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("a9:a9999")) Is Nothing Then
'---------------------------------------------------------------
 With target.Offset(0, 1)
    .FormulaR1C1 = "=IF(ISNA(INDEX(ProjectEntry,MATCH(rc1,ProjectEntry[Project No],FALSE),2)),"""",INDEX(ProjectEntry,MATCH(rc1,ProjectEntry[Project No],FALSE),2))"
    .Value = .Value
 End With

 With target.Offset(0, 2)
    .FormulaR1C1 = "=IF(ISNA(INDEX(AssetMaster,MATCH(rc1,AssetMaster[Asset No],FALSE),2)),"""",INDEX(AssetMaster,MATCH(rc1,AssetMaster[Asset No],FALSE),2))"
    .Value = .Value
 End With

End If

End Sub

When I used this code, only the asset no appears while description remains empty. The code should supposedly perform change in the row whenever a cell in the range I selected (a9:a9999) has its value changed.

Is this due to code limitation having to refer to 2 master sheets that it only refers to only Project Master while Asset Master is ignored? Is there a way to solve this issue?

2
vbaexcel
As a rule of thumb, it isn't a good idea to use VBA to write worksheet functions. The proof of this pudding is the fact that you got stuck almost on the first line of code. - Variatus
True. However this is just a testbed for a much larger project that is in progress where previously all the formulas are in the worksheet. That results in the masters suffering from severe slowdown whenever I try to filter the master tables. I find that placing the formulas in VBA and then having it save the value only help prevents this issue. - hjh93
why do you do this with VBA. Just write the formulas in the relevant cells. if you don't want errors to show in the cells, use IFERROR(yourlongformula,"") - ExcelinEfendisi
@Variatus The question clearly spells out that this is a special case where the rule of thumb needs to be broken. (As proven by the hjh93's comment directed at you.) - robinCTS
I agree with your logic. However, your request isn't to "put the formulas in VBA". It is to use VBA to write formulas to the worksheet. If the next step is to save the values calculated by the formulas my point would be proven: let VBA calculate the values and write them to the worksheet. Anyway, I have posted some code below and shall be glad if it proves helpful to you. - Variatus

2 Answers

1
votes

You have a bug in your second formula. It should read:

 With target.Offset(0, 2)
    .FormulaR1C1 = "=IF(ISNA(INDEX(AssetMaster,MATCH(RC2,AssetMaster[Asset No],FALSE),2)),"""",INDEX(AssetMaster,MATCH(RC2,AssetMaster[Asset No],FALSE),2))"
    .Value = .Value
 End With

The RC1 that you have should be RC2 (or RC[-1]).

EDIT:

A better formula to use (thanks ExcelinEfendisi) can be seen in the following code:

Private Sub Worksheet_Change(ByVal Target As Range)

  If Intersect(Target, Range("A9:A9999")) Is Nothing Then Exit Sub
  '---------------------------------------------------------------

  With Target.Offset(0, 1)
    .FormulaR1C1 = "=IFERROR(INDEX(ProjectEntry[Asset No],MATCH(RC[-1],ProjectEntry[Project No],0)),"""")"
    .Value = .Value
  End With
  With Target.Offset(0, 2)
    .FormulaR1C1 = "=IFERROR(INDEX(AssetMaster[Description],MATCH(RC[-1],AssetMaster[Asset No],0)),"""")"
    .Value = .Value
  End With

End Sub

But, as a lot of the comments suggest, the best way to refresh the edited row only is to do the calculations in VBA and write the results to the sheet.

The following code does this using the tables' ListObject objects:

Private Sub Worksheet_Change(ByVal Target As Range)

  If Intersect(Target, Range("A9:A9999")) Is Nothing Then Exit Sub
  '---------------------------------------------------------------

  Dim Ä As Excel.Application: Set Ä = Excel.Application
  Dim varValue As Variant

  varValue = Ä.Index(Ä.Range("ProjectEntry[Asset No]"), Ä.Match(Target.Value2, Ä.Range("ProjectEntry[Project No]"), 0))
  Target.Offset(0, 1).Value = IIf(IsError(varValue), vbNullString, varValue)
  varValue = Ä.Index(Ä.Range("AssetMaster[Description]"), Ä.Match(varValue, Ä.Range("AssetMaster[Asset No]"), 0))
  Target.Offset(0, 2).Value = IIf(IsError(varValue), vbNullString, varValue)

End Sub

Note the usage of Application. instead of WorksheetFunction. to access the worksheet functions. This, coupled with the use of a Variant type variable, allows us to trap the error that occurs if the match fails.

0
votes

Paste this code into the code sheet of your "Data Entry" sheet. In my tests I called this sheet "JHJ93". Please change this name in the code.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 12 Sept 2017

    If Not Application.Intersect(Target, EntryRange(True)) Is Nothing Then
        ' "True" means: MUST select from the list
        SetValidation Target, ProjectList, True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 12 Sep 2017

    If Not Application.Intersect(Target, EntryRange) Is Nothing Then
        ' Here you want to call a function which is similar
        ' to "ProjectList" but returns a list of all Assets.
        ' this list you can feed to the Sub "SetValidation" to set
        ' the validation in column B of the Entry Sheet.
        ' Select the cell.
    End If
End Sub

Private Function EntryRange(Optional PlusOneRow As Boolean) As Range
    ' 12 Sep 2017
    ' add one row to the range at the bottom if PlusOneRow is True

    Dim Rl As Long

    With Worksheets("HJH93")            ' this would be your Data Entry sheet
                                        ' please change the name as required
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row + Abs(PlusOneRow)
        ' start entries on row 2 (first row = captions)
        Rl = Application.Max(Rl, 2)
        Set EntryRange = .Range(.Cells(2, "A"), .Cells(Rl, "A"))
    End With
End Function

Private Function ProjectList() As String
    ' 12 Sep 2017
    ' return the current (unique) list of all projects
    ' comma=separated for use in validation dropdown

    ' if the list becomes quite long you may have to design
    ' a faster method of creating this list

    Dim Fun As String                       ' function return string
    Dim Tmp As String
    Dim Rl As Long
    Dim R As Long

    With Worksheets("Project Master")
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        For R = 2 To Rl                     ' Row 1 is presumed to have a caption
            Tmp = Trim(.Cells(R, "A").Value)
            If InStr(1, Fun, Tmp, vbTextCompare) = 0 Then
                ' presuming that your list separator for validation lists
                ' is a comma
                Fun = Fun & "," & Tmp
            End If
        Next R
    End With
    If Len(Fun) Then ProjectList = Mid(Fun, 2)
End Function

Private Sub SetValidation(Tgt As Range, _
                          DdList As String, _
                          Optional SelectOnly As Boolean, _
                          Optional Del As Boolean)
    ' 12 Sep 2017
    ' Set or delete validation in Tgt

    With Tgt.Validation
        .Delete

        If Not Del Then
            .Add Type:=xlValidateList, Formula1:=DdList
            .InCellDropdown = True
            .ShowInput = True
            .IgnoreBlank = False
            .ShowError = SelectOnly
            If SelectOnly Then
                .ErrorTitle = "Required entry"
                .ErrorMessage = "Please select an existing list item."
            End If
        End If
    End With
End Sub

I have added a lot of comments for you to find your bearings but here is a short description nevertheless:-

When you click in the "Project" field (column A) of your "Data Entry" sheet a validation list is generated of all projects in the "Projects Master". You select one of the projects. This selection triggers the Change event. That procedure should select the cell in column B, generate a similar list of Assets, from which you select an asset. I stopped coding here because it seemed to me that you hadn't considered that there should be many assets per project (or I didn't understand the issue correctly).

However, after that dropdown has been set, a selection is made which triggers another Change event. That event must pick the selected Asset's description. You can use Application.Vlookup for that, meaning you can embed the function in VBA and write the result to the worksheet, as opposed to writing the formula to the worksheet and asking Excel to do the search for you.

This process I have started here may seem more laborious to you but, believe me, that is only because you haven't taken your own method to its bitter end yet.