matching up data
I have a 2 sets of data, the newer data has more information then the old. I
want to be able to run a macro that goes through the old data and finds where its missing info from the newer data and insert a row to make the 2 sets of data match up. So it will find that it doesnt match up and insert rows where it needs to. Any ideas? data A data B 2 2 6 7 7 10 9 11 10 11 |
matching up data
Option Explicit
Sub testme() Application.ScreenUpdating = False Dim wks As Worksheet Dim ColA As Range Dim ColB As Range Dim iRow As Long Dim myCols As Long Set wks = Worksheets("sheet1") .DisplayPageBreaks = False With wks .DisplayPageBreaks = False 'row 1 has headers! Set ColA = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp)) Set ColB = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp)) With ColA .Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo End With 'change the mycols to the number of columns that 'are associated with column B myCols = 1 ' columns B only With ColB.Resize(, myCols) .Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo End With iRow = 2 Do If Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 0 Then Exit Do End If If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value _ Or Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 1 Then 'do nothing Else If .Cells(iRow, "A").Value .Cells(iRow, "B").Value Then .Cells(iRow, "A").Insert shift:=xlDown Else .Cells(iRow, "B").Resize(1, myCols).Insert shift:=xlDown End If End If iRow = iRow + 1 Loop End With Application.ScreenUpdating = True End Sub Jase wrote: I have a 2 sets of data, the newer data has more information then the old. I want to be able to run a macro that goes through the old data and finds where its missing info from the newer data and insert a row to make the 2 sets of data match up. So it will find that it doesnt match up and insert rows where it needs to. Any ideas? data A data B 2 2 6 7 7 10 9 11 10 11 -- Dave Peterson |
All times are GMT +1. The time now is 09:03 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com