Help with fixing match problem in code

Hi

I have code that is not writing the expected result and so I could really use some help with making the necessary adjustments. I don’t want to change the code.

Using the Excel image below the expected written result is the grey highlight in the D5:H17 box area. The data gets written based on any set of numbers in the range E6:E17 and comes from the data source 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. I have also uploaded my Excel workbook.

Thanks so much for any help.

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

WRITE PROBLEM.png

Why do you need all that VBA - couldn't you just use some simple formulae?

Hi

Thanks for your replies. To KOKOSEK question on something other than 10-1. It could be any set of numbers 99-8 or whatever is the criteria for the code to write the numbers from the data source. On "relation between values in col E or just if it is not empty do copies? " if the cell range is empty no writing from the data source occurs.

To StephanR: Need all this VBA because this is just one example of data. When you have maybe a hundred or more in the future it's better to have code. Also other issues.

I think it's the match that's the issue.

Thanks so much

Hi KOKOSEK

I tried but it didn't work. Thanks so much for your attempt. Please close this posting.