formula

melgra1965

Copper Contributor

Sep 08, 2022

DexterG_III I want to match column to column b, row by row. If they do not match i want an empty space left so I end with the same number of rows in each column. In column A I only have 800 numbers, in column B I have 1500. I want to column A spread out to match column B so they both have 1500 rows when done.

A	B
13326	13326
17356	17356
45514	45514
	43143
	33138
36386	36386
	1415
54788	54788
9266	9266
	12851
12687	12687
5684	5684
5472	5472
19774	19774
	46907
	55386
54044	54044
38152	38152
	50981
49910	49910

HansVogelaar

MVP

Sep 08, 2022

melgra1965

A safer version:

Sub MatchColumns()
    Dim r As Long
    Dim rng As Range
    Application.ScreenUpdating = False
    r = 1
    Do
        Set rng = Range("B" & r & ":B" & Rows.Count).Find(What:=Range("A" & r).Value, LookAt:=xlWhole)
        If rng Is Nothing Then
            MsgBox "The value of A" & r & " was not found", vbCritical
            Exit Do
        ElseIf rng.Row = r Then
            r = r + 1
        Else
            Range("A" & r).Resize(rng.Row - r).Insert Shift:=xlShiftDown
            r = rng.Row + 1
        End If
    Loop Until Range("B" & r).Value = ""
    Application.ScreenUpdating = True
End Sub

HansVogelaar

MVP

Sep 08, 2022

melgra1965

Using your last example, you can run the macro below. But be very careful: if there is a value in column A that does not occur in column B, the code will go into an endless loop.

Sub MatchColumns()
    Dim r As Long
    Application.ScreenUpdating = False
    Do
        Do While Range("A" & r).Value <> Range("B" & r).Value
            Range("A" & r).Insert Shift:=xlShiftDown
            r = r + 1
            If Range("B" & r).Value = "" Then Exit Do
        Loop
        r = r + 1
    Loop Until Range("B" & r).Value = ""
    Application.ScreenUpdating = True
End Sub

Forum Discussion