VBA solution for finding missing data

[warren66]

Is there a VBAsolution to the following scenario?
I have two columns of numbers, in A & E and i would like them levelling up where values are present on one but not the other, by inserting a cell in either column. When complete, the cells in Cols A & E should the the same, or present in one but not the other.

 

[Joe4]

Can you please show us some sample data, and your expected results?

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[warren66]

Before the macro runs, typical data could be:

test.xlsx
	A	B	C	D	E
1	1				1
2	2				64
3	64				309
4	100				321
5	309				575
6	321				577
7	575				609
8	577				739
9	609				1000
10	739				2164
11	2164				2182
12	2182				2276
13	2276				2286
14	2286				2303
15	2303				2439
16	2439				2441
17	2441				2455
18	2455				2456
19	2456				2501
20	2500				2533
21	2533				2534
22	2534				2537
23	2537				2549
24	2549				2557
25	2557				2559
26	2559				2561
27	2561				3000
Sheet3

After the macro has run, it should look like this:

test.xlsx
	A	B	C	D	E
1	1				1
2	2
3	64				64
4	100
5	309				309
6	321				321
7	575				575
8	577				577
9	609				609
10	739				739
11					1000
12	2164				2164
13	2182				2182
14	2276				2276
15	2286				2286
16	2303				2303
17	2439				2439
18	2441				2441
19	2455				2455
20	2456				2456
21	2500
22					2501
23	2533				2533
24	2534				2534
25	2537				2537
26	2549				2549
27	2557				2557
28	2559				2559
29	2561				2561
30					3000
Sheet4

 

[Joe4]

OK, this code seems to do what you want (I verified it returns the desired results you posted):

Sub FixData()

    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Set initial value to row 1
    r = 1
   
'   Loop until for boths A and E are blank
    Do

'       Exit if both columns A and E are blank
        If Cells(r, "A") = "" And Cells(r, "E") = "" Then Exit Sub

'       Check to make sure both columns have a value
        If Cells(r, "A") <> "" And Cells(r, "E") <> "" Then
'           Compare columns A and E and insert row where necessary
            If Cells(r, "A") > Cells(r, "E") Then
'               Insert cell in column A
                Cells(r, "A").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Else
                If Cells(r, "A") < Cells(r, "E") Then
'                   Insert cell in column E
                    Cells(r, "E").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                End If
            End If
        End If
   
'       Incrementer row counter
        r = r + 1

    Loop
   
    Application.ScreenUpdating = True
   
End Sub

 

[warren66]

Worked first time. Thank you so much

 

[Joe4]

You are welcome. Glad I was able to help!