Haywire Match Function

Question

I am grappling with a bizarre Match malfunction which is difficult to understand and seek explanations for possible causes.

Several authors have helped compile the following code:

    Dim t1s As Long: t1s = 1
    Dim t2s As Long: t2s = 6
    Dim t1l As Long: t1l = 4 - 1
    Dim t2l As Long: t2l = 5 - 1
    Dim r As Long
    Dim rMatch As Long

    With wsR
        For r = wsR.Cells(.Rows.Count, t1s).End(xlUp).Row To 2 Step -1
            If Application.WorksheetFunction.CountIf(.Columns(t2s), wsR.Cells(r, t1s).Value) > 0 Then
    
                rMatch = Application.WorksheetFunction.Match(.Cells(r, t1s).Value, .Columns(t2s), 0)
            
                .Range(.Cells(r, t2s), .Cells(r, t2s + t2l)).Insert shift:=xlDown
                .Range(.Cells(rMatch, t2s), .Cells(rMatch, t2s + t2l)).Cut
                .Select
                .Range(.Cells(r, t2s), .Cells(r, t2s + t2l)).Select
                .Paste
                .Range(.Cells(rMatch, t2s), .Cells(rMatch, t2s + t2l)).Delete
                                
            End If
        Next r
    End With

The code runs beautifully (match, insert, cut, paste, delete, repeat) until halfway through a dataset, at which point it then inexplicably "breaks", returning unmatched cells and shifting rows beneath the deleted row, up. This action also scrambles the prior correct results above.

I have debugged line by line and can find no clue apart from the fact it coincides with date changes in a corresponding column. Excel does have some oddities but I am convinced there is a simple explanation. Whoever knows a good place to start, please do not simply provide a solution - it's really important I learn the skill of debugging.

Many thanks.

See [Excel VBA deleting rows in a for loop misses rows](https://stackoverflow.com/questions/43454139/excel-vba-deleting-rows-in-a-for-loop-misses-rows). And also get rid of your `Select`'s. See [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Ron Rosenfeld, Jul 06 '20 at 11:19
Thank you @SJR. Your tips resolved mass deletion and scrambling of matched results. However, it is still not finding matches, missing by 1 line up or down in most cases, sometimes by much larger gaps. I respect the rules of this platform: should I pose as a separate question? — Geoffrey Turner, Jul 06 '20 at 12:32
Thank you @RonRosenfeld. Your contribution helped simplify the code and I will further reduce by omitting Selects after the algo runs smoothly. — Geoffrey Turner, Jul 06 '20 at 12:34
Hi @SJR. Super Symmetry identified a means to reduce the problem. I believe what remains now falls in-scope of the original question happily. It turns out, deleting the increment imposed near-perfect order - all matches now sit exactly 1 row above their pairs. Close. How do I shift them down a row to align perfectly (Q contains updated code)? — Geoffrey Turner, Jul 06 '20 at 13:54

Super Symmetry · Accepted Answer · 2020-07-06T14:44:35.193

0

Try replacing the line .Range(.Cells(rMatch + 1, t2s), .Cells(rMatch + 1, t2s + t2l)).Delete with

.Range(.Cells(rMatch + 1, t2s), .Cells(rMatch + 1, t2s + t2l)).Delete Shift:=xlUp

Edit: Ok, I think you need to account for situations when rMatch = r and rMatch < r. See if it helps (tested it on made-up data as I don't have sample data):

    Dim t1s As Long: t1s = 1
    Dim t2s As Long: t2s = 6
    Dim t1l As Long: t1l = 4 - 1
    Dim t2l As Long: t2l = 5 - 1
    Dim r As Long
    Dim rMatch As Long

    With Sheets(1) ' wsR
        For r = .Cells(.Rows.Count, t1s).End(xlUp).Row To 2 Step -1
            If Application.WorksheetFunction.CountIf(.Columns(t2s), .Cells(r, t1s).Value) > 0 Then
    
                rMatch = Application.WorksheetFunction.Match(.Cells(r, t1s).Value, .Columns(t2s), 0)
                If rMatch <> r Then
                    .Range(.Cells(r + 1, t2s), .Cells(r + 1, t2s + t2l)).Insert shift:=xlDown
                    .Range(.Cells(rMatch, t2s), .Cells(rMatch, t2s + t2l)).Cut
                    .Select
                    .Range(.Cells(r + 1, t2s), .Cells(r + 1, t2s + t2l)).Select
                    .Paste
                    .Range(.Cells(rMatch, t2s), .Cells(rMatch, t2s + t2l)).Delete
                End If
            End If
        Next r
    End With

edited Jul 06 '20 at 14:44

answered Jul 06 '20 at 12:28

Super Symmetry

2,837
1
6
17

Hi @Super Symmetry. No luck. – Geoffrey Turner Jul 06 '20 at 12:40
1

Just occurred to me: a logical bug might be that at some point `rMatch` is less than your itterating `r` in which case you should not increment `rMatch` by 1 when deleting. This might happen if the values matched can have dupicates – Super Symmetry Jul 06 '20 at 12:47
Played around with your ideas and found deleting the increment imposed near-perfect order - all matches now sit exactly 1 row above their pairs. Close. How do I shift them down a row to align perfectly (Q contains updated code)? – Geoffrey Turner Jul 06 '20 at 13:47
I think you still need the increment if `rMatch > r`. You also should account for the situation when `rMatch = r`, in which case you shouldn't really do anything. I updated my answer; see if it helps. – Super Symmetry Jul 06 '20 at 14:15
Ok, I didn't realise you'd changed your loop to count backwards. Try the last updated code. I tested it on some mock data, which doesn't have duplicates. – Super Symmetry Jul 06 '20 at 14:48

Haywire Match Function

1 Answers1