macro to check two data sets

[ajaf123]

hello. I have two sets of data bases both containing data with unique ID in column A.In ColumnB there are amounts (it varies how many amounts are with each ID). for example:
first data

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

A B C
1 id Amount Date
2 a112 200 dd-mm-yyy
3 1200 dd-mm-yyy
4 5 dd-mm-yyy
5 B112 500 dd-mm-yyy
6 400 dd-mm-yyy
7 C112 100 dd-mm-yyy

Second database:
A B C
1 id Amount Date
2 a112 1400 dd-mm-yyy
3
4 5
5
6
7 C112 100 dd-mm-yyy

I want a macro to match the sum of amounts with respective IDs and tick in the next column (columnE) when the sum of amounts equal. Also highlight in red if date with any ID of data2 is greater than that in data1.

 

[Juanca1080]

Hi,
First of all, let me check if I got it right.
You have two set databases located in different sheets (Sheet 1 and Sheet 2). Both of them have the same structure (Id-Amount-Date), and you want to:
1. Sum the amounts that correspond to the same Id in column D.
2. Check if the amounts of some Id are equal (in both DataBases), and if so, show it in column E.
3. Check if for any Id, its date in DataBase2 is greater than the the one in DataBase1, and if so, highlight that date in red.
If I understood correctly, you could try this to see if it meets your needs.

Note that in the macro I assume both databases are located in the first and second sheet of the same workbook respectively, starting in A1 (first row for headers)

Option Explicit
Sub CompareData()
Dim IdRow As Long
Dim SearchRng As Range
Sheets(2).Activate
Set SearchRng = Sheets(2).Range("A1", Range("A1").End(xlDown))
Sheets(1).Activate
Range("A2").Select
Do While ActiveCell <> ""
IdRow = Application.WorksheetFunction.Match(ActiveCell.Value, SearchRng, 0)
Sheets(2).Cells(IdRow, 4) = Cells(ActiveCell.Row, 2).Value + Sheets(2).Cells(IdRow, 2).Value
If Cells(ActiveCell.Row, 2) = Sheets(2).Cells(IdRow, 2) Then
Sheets(2).Cells(IdRow, 5).Value = "EQUAL"
End If
ActiveCell.Offset(1, 0).Select
On Error Resume Next
If CDate(Cells(ActiveCell.Row, 3)) < CDate(Sheets(2).Cells(IdRow, 3)) Then
Sheets(2).Cells(IdRow, 3).Font.Color = vbRed
End If
Loop
Sheets(2).Activate
End Sub

 

[ajaf123]

hey thanks for the response. I tried the code but it gives application defined error. it highlights the 'set searchrng' line.

Hi,
First of all, let me check if I got it right.
You have two set databases located in different sheets (Sheet 1 and Sheet 2). Both of them have the same structure (Id-Amount-Date), and you want to:
1. Sum the amounts that correspond to the same Id in column D.
2. Check if the amounts of some Id are equal (in both DataBases), and if so, show it in column E.
3. Check if for any Id, its date in DataBase2 is greater than the the one in DataBase1, and if so, highlight that date in red.
If I understood correctly, you could try this to see if it meets your needs.

Note that in the macro I assume both databases are located in the first and second sheet of the same workbook respectively, starting in A1 (first row for headers)

Option Explicit
Sub CompareData()
Dim IdRow As Long
Dim SearchRng As Range
Sheets(2).Activate
Set SearchRng = Sheets(2).Range("A1", Range("A1").End(xlDown))
Sheets(1).Activate
Range("A2").Select
Do While ActiveCell <> ""
IdRow = Application.WorksheetFunction.Match(ActiveCell.Value, SearchRng, 0)
Sheets(2).Cells(IdRow, 4) = Cells(ActiveCell.Row, 2).Value + Sheets(2).Cells(IdRow, 2).Value
If Cells(ActiveCell.Row, 2) = Sheets(2).Cells(IdRow, 2) Then
Sheets(2).Cells(IdRow, 5).Value = "EQUAL"
End If
ActiveCell.Offset(1, 0).Select
On Error Resume Next
If CDate(Cells(ActiveCell.Row, 3)) < CDate(Sheets(2).Cells(IdRow, 3)) Then
Sheets(2).Cells(IdRow, 3).Font.Color = vbRed
End If
Loop
Sheets(2).Activate
End Sub

 

[ajaf123]

please also note that the number of values in front of any ID is not the same.For example A2 has first ID with amounts in b2,b3,b4. then a5 would have second ID with amounts in just b5 and b6 perhaps. then a7 starts with 3rd ID. It is also possible that first ID has three amounts in sheet1 but only two amounts in sheet2. Thats why the sum of individual 2 sheets must tally ID-wise.

 

[Juanca1080]

Hi,
To avoid getting the application defined error, it would be very helpful if you give me the name of the sheets in which each DataBase is located.
About the Id issue I have two questions:
1. I understand that an Id could appear any number of times in the same DataBase, but does the Id always appears in column A (even for repeated records) or does it just appear in the first row of a group of records with the same Id. I mean:

A B
1 Id1 100
2 Id1 320
3 Id1 480
4 Id2 180
5 Id2 90
6 Id3 210

Or is it:

A B
1 Id1 100
2 Empty 320
3 Empty 480
4 Id2 180
5 Empty 90
6 Id3 210

2. The macro should sum all the values for the same Id in both DataBases (All at once), or should it sum the values for the same Id in each DataBase separately and then compare the sums for each Id in both DataBases.

 

[ajaf123]

The sheets are" IT data "and "division data". It's like the second option that you presented. The ID only appears once in each sheet with subsequent records in column B.

Hi,
To avoid getting the application defined error, it would be very helpful if you give me the name of the sheets in which each DataBase is located.
About the Id issue I have two questions:
1. I understand that an Id could appear any number of times in the same DataBase, but does the Id always appears in column A (even for repeated records) or does it just appear in the first row of a group of records with the same Id. I mean:

A B
1 Id1 100
2 Id1 320
3 Id1 480
4 Id2 180
5 Id2 90
6 Id3 210

Or is it:

A B
1 Id1 100
2 Empty 320
3 Empty 480
4 Id2 180
5 Empty 90
6 Id3 210

2. The macro should sum all the values for the same Id in both DataBases (All at once), or should it sum the values for the same Id in each DataBase separately and then compare the sums for each Id in both DataBases.

 

[ajaf123]

it should sum the values in both databases for each ID separately and check if thy are equal. I think Range function can be used here along with xldown and then offset by one column for both databases.

 

[ajaf123]

I was thinking something on the following lines:

For i = 2 To 1000 Step 1
For k = 2 To 1000 Step 1
If ActiveSheet.Cells(i, 1).Value = Sheets(2).Cells(k, 1).Value Then
Sheets(2).Cells(k, 1).End(xlDown).Offset(0, 1).Add

 

[Juanca1080]

Hi,
The following procedure uses the SUMIF function to get the subtotals for each ID in each DB. I have one concern about the macro though, it seems to me that it may be a bit lengthy with very large amount of data as it uses two loops (I just tried it with about 25 records in each DB). So it’s a matter of giving it a try.
Please note that the macro doesn’t compare the sums and dates yet. I want to see if this step works before going any further, since the other two steps don’t seem to be very complicated.
Let me know how it goes.

Option Explicit
Sub CompareData()
Dim i As Integer
Dim Sh(1) As String
Dim LastRow As Long
Dim IdRng As Range
Dim ValRng As Range
Sh(0) = "IT data"
Sh(1) = "division data"
Application.ScreenUpdating = False
For i = 0 To 1
Sheets(Sh(i)).Activate
LastRow = Range("B65536").End(xlUp).Row
Set IdRng = Range("A2", "A" & LastRow)
Set ValRng = Range("B2", "B" & LastRow)
Range("A2").Select
' Fill empty cells in column A with the cell above
Do Until ActiveCell.Row = LastRow + 1
    If ActiveCell = "" Then
    ActiveCell = ActiveCell.Offset(-1, 0).Value
    ActiveCell.Font.Color = vbBlue
    End If
ActiveCell.Offset(1, 0).Select
Loop
' Get subtotals for each Id, using SumIf function
Range("A2").Select
Do Until ActiveCell.Row = LastRow + 1
If ActiveCell <> ActiveCell.Offset(-1, 0).Value Then
Cells(ActiveCell.Row, 4) = Application.WorksheetFunction.SumIf(IdRng, ActiveCell.Value, ValRng)
End If
ActiveCell.Offset(1, 0).Select
Loop
' Clear the empty cells filled before
ActiveSheet.UsedRange.AutoFilter Field:=1, _
Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor
IdRng.SpecialCells(xlCellTypeVisible).Select
Selection.Clear
Selection.AutoFilter
Next i
Application.ScreenUpdating = True
End Sub

 

[ajaf123]

Hello. Sorry for the late response. I molded the macro to fit my sheet. One last thing. The macro works fine if i enter IDs in column A. But the results get distorted if i enter names in column A. is there a way for the macro to check for string (Names) instead of IDs?


about the macro though, it seems to me that it may be a bit lengthy with very large amount of data as it uses two loops (I just tried it with about 25 records in each DB). So it’s a matter of giving it a try.
Please note that the macro doesn’t compare the sums and dates yet. I want to see if this step works before going any further, since the other two steps don’t seem to be very complicated.
Let me know how it goes.

Option Explicit
Sub CompareData()
Dim i As Integer
Dim Sh(1) As String
Dim LastRow As Long
Dim IdRng As Range
Dim ValRng As Range
Sh(0) = "IT data"
Sh(1) = "division data"
Application.ScreenUpdating = False
For i = 0 To 1
Sheets(Sh(i)).Activate
LastRow = Range("B65536").End(xlUp).Row
Set IdRng = Range("A2", "A" & LastRow)
Set ValRng = Range("B2", "B" & LastRow)
Range("A2").Select
' Fill empty cells in column A with the cell above
Do Until ActiveCell.Row = LastRow + 1
    If ActiveCell = "" Then
    ActiveCell = ActiveCell.Offset(-1, 0).Value
    ActiveCell.Font.Color = vbBlue
    End If
ActiveCell.Offset(1, 0).Select
Loop
' Get subtotals for each Id, using SumIf function
Range("A2").Select
Do Until ActiveCell.Row = LastRow + 1
If ActiveCell <> ActiveCell.Offset(-1, 0).Value Then
Cells(ActiveCell.Row, 4) = Application.WorksheetFunction.SumIf(IdRng, ActiveCell.Value, ValRng)
End If
ActiveCell.Offset(1, 0).Select
Loop
' Clear the empty cells filled before
ActiveSheet.UsedRange.AutoFilter Field:=1, _
Criteria1:=RGB(0, 0, 255), Operator:=xlFilterFontColor
IdRng.SpecialCells(xlCellTypeVisible).Select
Selection.Clear
Selection.AutoFilter
Next i
Application.ScreenUpdating = True
End Sub

[/QUOTE]