Dear Excel community,
I'll like to compare excel data sets in one sheet.
These Excel tables are extended or reduced monthly, making it difficult to compare.
Below you'll find a workbook with 2 sheets called 'Before' and 'After'.
The before-sheet shows the table before applying the script and the after-sheet shows the desired results.
Since the length and width of the datasets can vary every month, the script should be able to handle shorter or wider or even both shorter and wider tables.
However, it might be worth a thought to use an input field to outline the range of the table.
I marked the datasets, in different colors, i. e. several tables in one.
The script should always take the first column of each dataset and compare it. Those lines in the first column that have a match should move the script to the same row so that the tables become comparable.
It is very important that the order of the columns to be compared is never changed, but, as already mentioned, the first column that have a match should move the script to the same row so that the tables become comparable.
The attached script can handle small datasets but there is the problem that the script does not know how wide and country the table is and the data fullness is also a weak point.
I'd be happy if someone could help me.
Many, many thanks to all of you.
Tom
Here are the Code and the Workbook
Code:
Sub foo()
Dim lCount As Long
Dim lCols As Long
Dim lRows As Long
Dim l As Long
Dim v As Variant
Dim ws As Worksheet
Dim c As Range
Dim dic As Object
For Each ws In ThisWorkbook.Worksheets
Set dic = CreateObject("Scripting.Dictionary")
With ws
Do Until .UsedRange.Rows(1).Row = 1
.Rows(1).EntireRow.Delete
Loop
Set c = .Range("A1")
v = c.Value
Do Until v <> ""
Set c = c.Offset(0, 1)
v = c.Value
Loop
lCount = Application.CountIf(.UsedRange.Rows(1), v)
lCols = .UsedRange.Rows(1).Find(what:=v, After:=c).Column - c.Column
Set c = Nothing
For l = 1 To lCols * lCount Step lCols
Set c = .UsedRange.Columns(l).Find(what:="Total", LookAt:=xlPart)
If c Is Nothing Then Set c = .UsedRange.Columns(l).Find(what:="* Estimated", LookAt:=xlPart)
If c Is Nothing Then Set c = .UsedRange.Cells(.UsedRange.Rows.Count, 1).Offset(1, 0)
If Not c Is Nothing Then
lRows = c.Row - 2
.Cells(2, l).Resize(lRows, lCols).Sort Key1:=.Cells(2, l), Order1:=xlAscending, Header:=xlNo
For Each c In .Cells(2, l).Resize(lRows, 1)
If c.Value <> "" Then dic(c.Value) = c.Value
Next c
End If
Next l
Set dic = SortDic(dic)
For l = 1 To lCols * lCount Step lCols
For lRows = 0 To dic.Count - 1
With .Cells(lRows + 2, l)
If Not .Value = dic.items()(lRows) Then
.Resize(1, lCols).Insert shift:=xlDown
End If
End With
Next lRows
Next l
End With
Set dic = Nothing
Next ws
End Sub
Public Function SortDic(dic As Object) As Object
Dim s() As String
Dim v As Variant
Dim i As Integer
Dim j As Integer
If dic.Count > 1 Then
ReDim s(dic.Count)
i = 0
For Each v In dic
s(i) = v
i = i + 1
Next
For i = 0 To (dic.Count - 2)
For j = (i + 1) To (dic.Count - 1)
If s(i) > s(j) Then
v = s(j)
s(j) = s(i)
s(i) = v
End If
Next
Next
Set SortDic = CreateObject("Scripting.Dictionary")
For i = 0 To (dic.Count - 1)
SortDic.Add s(i), dic(s(i))
Next
Else
Set SortDic = dic
End If
End Function