CODEWITHSUNDEEP
excelexcel-formulavba
Babyburger
Babyburger

Reputation: 1830

index match with a condition (Excel or VBA)

I have two columns in an Excel spreadsheet:

A  |  B
---|---
DL | KO
D4 | KO
SO | PL
SS | PL

This is just an example, in my actual spreadsheet I use longer strings. Now I would like to implement something so that next time I type a string in column A that starts with S, it automatically fills PL for B or if I type a string that starts with D, KO appears in B. If I type a string, let's say AL, that hasn't occurrred before, a default string (such as "FILL IN" or just the empty string) gets placed in B.

The idea is that I would then have to manually type in the string in B. If in the future I type a string that matches AL (not start with A, but exact match), it would be smart enough to recognize what to fill in for B.

First approach: Excel

Using index match:

=INDEX($N:$N;MATCH(ReturnFormattedCredit($K4)&"*";$K:$K;0))

which is supposed to return the string in column N, by matching the element in K4 as a substring of other elements in column K.

The helper function ReturnFormattedCredit is a VBA function I created myself:

Function ReturnFormattedCredit(c) As String
'Returns the formatted credit: For ZK credits this will be the first 3 alphabetical
'characters + the 4 following digits; for ZL credits this will be the first 2
'alphabetical characters + the following 6 digits; return the full string otherwise
    If StrComp(Left(c, 2), "ZL") = 0 Then
        ReturnFormattedCredit = Left(c, 8)
    ElseIf StrComp(Left(c, 2), "ZK") = 0 Then
        ReturnFormattedCredit = Left(c, 7)
    Else
        ReturnFormattedCredit = c
    End If
End Function

I have tested this function and it does what it's supposed to: extract only the necessary substring from a possibly larger string. The problem now, is that it will just look for the top element that matches in K, then return the corresponding string from column N in that row. But if that first element does not know the string (this means: it's also using this formula and the manually typed in ground truth is somewhere else in the column), it will cause a circle reference, since now that cell will try to find the answer but will continuously try to evaluate against itself.

Cells can be checked whether they are formulas are not using .HasFormula, but from the example above I can't seem to extract which particular cell to return in the second argument of INDEX this way.

Second approach: VBA

So I'm too inexperienced to figure out how to do this in Excel: try it in VBA.

Function GetProjectName(targetarray As Range, kredietarray As Range, krediet) As String
    For Each el In kredietarray.Cells
        targetEl = targetarray(el.Row - 1)
        If StrComp(ReturnFormattedCredit(krediet) & "*", el) And Not targetEl.HasFormula Then
            GetProjectName = "test"
            ' GetProjectName = targetEl
        End If
    Next
    GetProjectName = "No project name found"
End Function

I pass the column to extract the string from, the column to search over and the cell to compare the string with respectively: 

=GetProjectName($N2:$N10;$K2:$K10;$K5)

This is supposed to become:

=GetProjectName($N:$N;$K:$K;$K5)

For every cell in the K column, I'm going to try and match K5 with that cell. If there's a match, then the second check: the cell in the same row but column N must not be an Excel formula. If this is true, then I have found the string I wanted and that string must be returned. If it was an Excel Formula, then continue looking.

Unfortunately, this either doesn't find anything (print invalid value) or just prints 0. Having spammed Debug.Print messages in this function before I learned that the function often doesn't even get executed properly and I cannot figure out why.

Upvotes: 1

Views: 1338

Answers (1)

Ambie
Ambie

Reputation: 4977

If you reworded this question, a possible solution becomes more obvious. So you could say that the task is:

  1. Capture a change of cell in column "A". Use the cell value as a key in a database lookup and, if the item exists, populate the cell in column "B" with the item.
  2. Capture a change of cell in column "B". Check if the cell in column "A" contains a key that doesn't already exist in the database and, if it doesn't, add the item and key.

This can be done using a Collection as the database and the Worksheet_Change event. So in the code behind of Sheet1 (or whichever is your applicable sheet), you could paste the following:

Option Explicit
Private Const ENTRY_COL As Long = 1
Private Const ENTRY_ROW As Long = 1
Private Const OUTPUT_COL As Long = 2
Private Const OUTPUT_ROW As Long = 1
Private mInitialised As Boolean
Private mOutputList As Collection

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim entryKey As String
    Dim v As Variant

    If Not mInitialised Then Initialise

    For Each cell In Target.Cells
        'Handle if change is in col "A"
        If Not Intersect(cell, Me.Columns(ENTRY_COL)) Is Nothing Then
            If Len(cell.Value2) > 0 Then
                'Look up item with key
                entryKey = Left$(cell.Value2, 1)
                v = Empty
                On Error Resume Next
                v = mOutputList(entryKey)
                On Error GoTo 0
                Application.EnableEvents = False
                'If item is found, fill col "B"
                If Not IsEmpty(v) Then
                    Me.Cells(cell.Row, OUTPUT_COL).Value = v
                Else
                    Me.Cells(cell.Row, OUTPUT_COL).Value = "FILL IN"
                End If
                Application.EnableEvents = True
            End If
        'Handle if change is in col "B"
        ElseIf Not Intersect(cell, Me.Columns(OUTPUT_COL)) Is Nothing Then
            If Len(Me.Cells(cell.Row, ENTRY_COL).Value2) > 0 Then
                'Look up item with key
                entryKey = Left$(Me.Cells(cell.Row, ENTRY_COL).Value2, 1)
                v = Empty
                On Error Resume Next
                v = mOutputList(entryKey)
                On Error GoTo 0
                'If nothing found then add new item to list
                If IsEmpty(v) Then mOutputList.Add cell.Value2, entryKey
            End If
        End If
    Next


End Sub

Private Sub Initialise()
    Dim r As Long
    Dim rng As Range
    Dim v As Variant
    Dim entryKey As String
    Dim outputStr As String

    'Define the range of populated cells in columns "A" & "B"
    Set rng = Me.Range(Me.Cells(ENTRY_ROW, ENTRY_COL), _
                       Me.Cells(Me.Rows.Count, OUTPUT_COL).End(xlUp))

    'Read the values into an array
    v = rng.Value2
    Set mOutputList = New Collection

    'Populate the collection with item from col "B" and key from col "A"
    For r = 1 To UBound(v, 1)
        If Not IsEmpty(v(r, 1)) And Not IsEmpty(v(r, 2)) Then
            entryKey = Left$(v(r, 1), 1)
            outputStr = CStr(v(r, 2))
            On Error Resume Next
            mOutputList.Add outputStr, entryKey
            On Error GoTo 0
        End If
    Next

    mInitialised = True
End Sub

Upvotes: 1

Related Questions