Mismatch and Match issue

Asked by At

I have code that is not writing anything. I get a Match problem and a mismatch error in the code line below

rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")

is highlighted in yellow.

To quickly explain the code and using my Excel image below the expected written result is the grey highlight in cells F8,G8,H8. The data that gets written into these cells only occurs when any set of numbers get written in the cell range, E6:E17 and only then. The data source is from cells M5 to O17. So as an example when cell E8 (3rd line down) has the 10-1 in it the code would search the data source (3rd line down) and write from the data source cells M8/N8/O8 to cells F8/G8/H8.

Please don’t suggest using a formula because in the arr1 and arr2 I will be using about 50 or more ranges. I only want to use this code and just need help with making the necessary offset and match adjustments.

Sub PlaceNumbers()

    Dim c As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim last1 As Long, last2 As Long, rtar As Long, xtar As Long

    Application.ScreenUpdating = False

    With ActiveSheet
        'create arrays
        arr1 = Array(.Range("D5:H17"))
        arr2 = Array(.Range("L5:O17))                                                             '
        'loop through arrays
        For i = LBound(arr1) To UBound(arr1)
            Set rng1 = arr1(i)
            Set rng3 = arr2(i)                                                      
            last1 = .Cells(.Rows.Count, ColLetter(rng1.Columns(1).Column)).End(xlUp).Row
            last2 = .Cells(.Rows.Count, ColLetter(rng3.Columns(1).Column)).End(xlUp).Row

            For Each c In rng1.Offset(1, 1).Resize(, 1)
                If c <> "" Then
                    rtar = Evaluate("=MATCH(" & ColLetter(rng1.Columns(2).Column) & rng1.Row & "&" & ColLetter(rng1.Columns(3).Column) & rng1.Row & "," & ColLetter(rng3.Columns(1).Column) & "1:" & ColLetter(rng3.Columns(1).Column) & last2 & "&" & ColLetter(rng3.Columns(3).Column) & "1:" & ColLetter(rng3.Columns(3).Column) & last2 & ",0)")
                    xtar = Application.Match(c.Offset(0, -2), Range(ColLetter(rng3.Columns(1).Column) & rtar & ":" & ColLetter(rng3.Columns(1).Column) & last2), 0)
                    With Application.WorksheetFunction
                        c.Offset(0, 1) = .Index(Range(ColLetter(rng3.Columns(2).Column) & rtar & ":" & ColLetter(rng3.Columns(2).Column) & last2), xtar)
                        c.Offset(0, 2) = .Index(Range(ColLetter(rng3.Columns(3).Column) & rtar & ":" & ColLetter(rng3.Columns(3).Column) & last2), xtar)
                        c.Offset(0, 3) = .Index(Range(ColLetter(rng3.Columns(4).Column) & rtar & ":" & ColLetter(rng3.Columns(4).Column) & last2), xtar)
                    End With
                End If
            Next c
        Next
    End With

    Application.ScreenUpdating = True

End Sub

Function ColLetter(Collet As Integer) As String

    ColLetter = Split(Cells(1, Collet).Address, "$")(1)

End Function

Exec image

2 Answers

0
chillin On Best Solutions

I think the existing answer (https://stackoverflow.com/a/55959955/8811778) is better (provided it does what you need it to) as it's shorter and easier to maintain/debug.

But I include an alternative, longer version below.


If the only logic/rule that results in values in M8:O8 being written to F8:H8 is "number of rows down" (i.e. 3 rows down), then I don't think you really need to use MATCH function.

If I understand correctly, you just want the Nth row of the source data, where N corresponds to the row of whatever non-empty cell (in the yellow cells) you're currently processing.

If you change your For each c in rng1.Offset(1, 1).Resize(, 1) to instead loop through the yellow cells one row at a time, you will have access to N (otherwise you need to do some row arithmetic: c.Row - first row of yellow cells + etc...).

Note that N is the variable rowIndexRelativeToRange in the code below and is relative to the range, not the worksheet (i.e. first row in the yellow cells, not first row of the worksheet).

Option Explicit

Sub PlaceNumbers()

    Dim someSheet As Worksheet
    Set someSheet = ActiveSheet ' Refer to this sheet by name if possible

    With someSheet
        Dim arr1 As Variant
        arr1 = Array(.Range("D5:H17"))

        Dim arr2 As Variant
        arr2 = Array(.Range("L5:O17"))
    End With

    'Application.ScreenUpdating = False ' Uncomment when you think code is ready/working

    Dim i As Long
    Dim rng1 As Range, rng2 As Range
    For i = LBound(arr1) To UBound(arr1)
        Set rng1 = arr1(i)
        Set rng2 = arr2(i)

        ' We have to resize the ranges (to get rid of the first row and first column)
        ' You may want to re-think whether the addresses you specify (when creating arr1 and arr2)
        ' even need to include the first row and first column (e.g. E6:H17 instead of D5:H17)
        ' -- or whether you could just ensure the address passed in already excludes the first row and first column.
        ' It depends on whether you need to use the first row and first column (somewhere else in your code).
        ' But precluding them (if possible) would shorten/simplify the procedure's logic.

        Dim inputColumn As Range
        Set inputColumn = rng1.Offset(1, 1).Resize(rng1.Rows.Count - 1, 1) ' -1 when resizing, otherwise you're looking at range E6:E18, not E6:E17

        Dim dataSourceRange As Range
        Set dataSourceRange = rng2.Offset(1, 1).Resize(rng2.Rows.Count - 1, rng2.Columns.Count - 1)

        Dim rowIndexRelativeToRange As Long ' This index is 1-based and relative to the range, not the worksheet.
        For rowIndexRelativeToRange = 1 To inputColumn.Rows.Count
            If inputColumn(rowIndexRelativeToRange, 1) <> "" Then
                inputColumn(rowIndexRelativeToRange, 1).Offset(0, 1).Resize(, 3).Value = dataSourceRange(rowIndexRelativeToRange, 1).Resize(, 3).Value
            End If
        Next rowIndexRelativeToRange
    Next i

    'Application.ScreenUpdating = True ' Uncomment when you think code is ready/working

End Sub
0
GMalc On

Putting this here because I don't want to put in a comment. Why can't you use a worksheet change event? You can set the target range to multiple ranges. Place this code in the worksheet containing the two areas you showed in your example. When the value in a cell changes it will automatically update the three cells to the right.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E6:E17")) Is Nothing Then
        Range(Target.Address).Offset(, 1).Resize(1, 3).Value = Range(Target.Address).Offset(, 8).Resize(1, 3).Value
    End If
End Sub