3

I am using the below format to get an output from a finite list of outputs based on a finite list of inputs but I was wondering if there was a faster/ more efficient way of executing the code? is there a way of shortening the code?

The code works as it is but I have always executed tasks like this and I was just curious to know if there was a better way from a self development point of view.

    If Intersect(Target, Range(Dev_Status & "6:" & Dev_Status & "1000")) = Dev_Raised_IN Then
    
        Target_Column = Dev_Raised
    
        ElseIf Intersect(Target, Range(Dev_Status & "6:" & Dev_Status & "1000")) = Dev_Draft_IN Then
        
            Target_Column = Dev_Draft
            
        ElseIf Intersect(Target, Range(Dev_Status & "6:" & Dev_Status & "1000")) = Dev_Review_IN Then
        
            Target_Column = Dev_Review
            
        ElseIf Intersect(Target, Range(Dev_Status & "6:" & Dev_Status & "1000")) = Dev_Comments_IN Then
        
            Target_Column = Dev_Comments
            
        ElseIf Intersect(Target, Range(Dev_Status & "6:" & Dev_Status & "1000")) = Dev_Approved_IN Then
        
            Target_Column = Dev_Approved
        
    End If
1
  • Well, an actual example with data may help understand your question, but I would be looking at a table and vlookup() or index() with match(), b ut until you show some real (well fake ie simulated) data that is just a suggestion. Commented Feb 13, 2021 at 14:58

1 Answer 1

5

A good solution to repetition is often abstraction.

Dim src As Range
Set src = Me.Range(Dev_Status & "6:" & Dev_Status & "1000")

The Intersect function yields a Range object reference that is Nothing when the specified arguments don't intersect, and a Range representing the intersecting cells when they do. Assuming that code lives in some Worksheet_Change handler (and thus that Me is the Worksheet being handled) and Target is validated to only ever be a single cell, then we should be evaluating the intersection once:

Dim intersecting As Range
Set intersecting = Intersect(Target, Me.Range(Dev_Status & "6:" & Dev_Status & "1000"))

The code should handle that range being Nothing:

If intersecting Is Nothing Then Exit Sub

And then its value is safe to compare... or is it? If the cell contains a worksheet error value, its data type will be Variant/Error, and any kind of operation we do with that data type that doesn't involve Variant/Error operands on both sides of the operator, will throw a type mismatch error. So we should bail in that case too:

If IsError(intersecting.Value) Then Exit Sub

Now we can turn that repeated If...ElseIf...End If block into a Select Case block:

Select Case intersecting.Value

    Case Dev_Raised_IN
        Target_Column = Dev_Raised

    Case Dev_Draft_IN
        Target_Column = Dev_Draft

    Case Dev_Review_IN 
        Target_Column = Dev_Review

    Case Dev_Comments_IN 
        Target_Column = Dev_Comments

    Case Dev_Approved_IN 
        Target_Column = Dev_Approved

    Case Else
        'we don't have a target column:
        Target_Column = -1

End Select

The entire block can then be further streamlined into a simple one-liner key lookup, using either a keyed Collection, or a Dictionary.

Of course, such a collection needs to be initialized, but that can be made to happen once with a Static local, like so (first run enters the conditional, second run doesn't):

Static targetColumns As Collection
If targetColumns Is Nothing Then
    Set targetColumns = New Collection
    targetColumns.Add Dev_Raised, Dev_Raised_IN
    targetColumns.Add Dev_Draft, Dev_Draft_IN
    targetColumns.Add Dev_Review, Dev_Review_IN
    targetColumns.Add Dev_Comments, Dev_Comments_IN
    targetColumns.Add Dev_Approved, Dev_Approved_IN
End If

On Error Resume Next '"key not found"
Target_Column = targetColumns(intersecting.Value)
If Err.Number <> 0 Then Target_Column = -1
On Error GoTo 0
Sign up to request clarification or add additional context in comments.

1 Comment

Amazing! this is great, thank you for the in depth reply!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.