Requirement:
The user can run and export into Excel a membership list from a third party Oracle database as frequently as required. These reports comprise 15 columns with one row per member and up to 25,000 rows (members).
1st data cell is B5 – end data cell is P25000
As a rule, there is always a difference between each list as to the number of members on each list, for various reasons. However, it’s simply not practical to try and manually find and isolate the differences; that is, who has been dropped off (or been added) to the membership list between each run, so the user hoping someone can assist and comment if it is feasible for VBA to do what is required?
The user has attached a sample workbook containing 50 records and representing the results required.
The workbook has four (4) sheets: 1_Previous, 2_Current, 3_Dropped, 4_New.
Presumably by clicking a Command button the code will do the following:
a. Compare 1_Previous with 2_Current;
b. For every record that appears in 1_Previous but does not appear in 2_Current;
c. Place a COPY of those records in 3_Dropped in alphabetical order by member Surname;
d. THEN, for every record that doesn’t appear in 1_Previous but does appear in 2_Current;
e. Place a COPY of those records in 4_New in alphabetical order by member Surname.
Solution:
Sub MG30Jul56 Dim Rng As Range, Dn As Range, n As Long, txt As String, Ray() As Variant, Ac As Long Dim Current As Variant, Previous As Variant, c As Long, r As Long, Var1 As Variant, Var2 As Variant Current = Sheets("2_Current").Cells(5, 2).CurrentRegion Previous = Sheets("1_Previous").Cells(5, 2).CurrentRegion Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)) For r = 1 To 2 With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare If r = 1 Then Var1 = Current: Var2 = Previous Else Var1 = Previous: Var2 = Current End If For n = 5 To UBound(Var1, 1) ' This is for entire row if required ' Join(Application.Index(Var1, n, 0), ",") txt = Var1(n, 1) & Var1(n, 2) & Var1(n, 3) .Item(txt) = Empty Next n For n = 5 To UBound(Var2, 1) ' This is for entire row if required 'txt = Join(Application.Index(Var2, n, 0), ",") txt = Var2(n, 1) & Var2(n, 2) & Var2(n, 3) If Not .exists(txt) Then c = c + 1 ReDim Preserve Ray(1 To UBound(Var2, 2), 1 To c) For Ac = 1 To UBound(Var2, 2) Ray(Ac, c) = Var2(n, Ac) Next Ac End If Next n If r = 1 Then With Sheets("3_Dropped").Range("B5").Resize(c, UBound(Previous, 2)) .Parent.Range("B5").Resize(200, 100).ClearContents .Value = Application.Transpose(Ray) .Sort key1:=.Parent.Range("C5"), order1:=xlAscending, Header:=xlNo End With Erase Ray: c = 0 Else With Sheets("4_new").Range("B5").Resize(c, UBound(Previous, 2)) .Parent.Range("B5").Resize(200, 100).ClearContents .Value = Application.Transpose(Ray) .Sort key1:=.Parent.Range("C5"), order1:=xlAscending, Header:=xlNo End With End If End With Next r End Sub
Obtained from the OzGrid Help Forum.
Solution provided by MickG.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
How to sort results after copying data from multiple sheets |
How to look for value in three different ranges and return one of three results |
How to use a formula to drag down, listing top 10 smallest results from matrix |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.