Compare 2 sets of data and highlight the difference value

Abinav

New Member
Joined
Sep 21, 2017
Messages
36
Hello

Please find my requirements. I have 2 sets of data which needs to be sorted to ascending order. Headers starts from Row 4. 1st data is with headers 'Account(with numbers- Col A and 'Total-Col B (with positive & negative values also ). 2nd data is with the same headers and values-Col D & E. I want to compare the column A & D first vice versa and i want the code to display the missing values in both the columns. then i want the code to compare the total columns B & E and display the amount does not match. Also I need the code to convert the values to number since the Account Column values are in text.

okdmr.jpg


Grand total fields needs to be ignored.
Note- Col B has few values in negative values which is there in Col E. Same value as below . code should ignore these values regardless of the negative figures since the values are same. For example,
Col B Col E
53024 -132
53024 132
53025 -7327.44 53025 7327.44

Thanks for your help :)
 
Here is my full code Mart

Private Sub CommandButton1_Click()


On Error Resume Next
With Range("B3:B2500")
.Value = .Value
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Remove
End Sub


Sub Remove()
Dim rngDel As Range
Dim A As Long


For A = Range("I" & Rows.Count).End(xlUp).Row To 2 Step -1
With Cells(A, 9)
If .Value Like "*X1*" Or .Value Like "*X2*" Or .Value Like "*X3*" Then
If rngDel Is Nothing Then
Set rngDel = .EntireRow
Else
Set rngDel = Union(rngDel, .EntireRow)
End If
End If
End With
Next A


If Not rngDel Is Nothing Then rngDel.Delete xlShiftUp
Sortdate
End Sub


Sub Sortdate()
Sheet1.Range("P3", "P3000").NumberFormat = "yyyymmdd"
InsertColumn
End Sub




Sub InsertColumn()
Columns("AE:AE").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AE2").Value = "*Company"
sbRangeData
End Sub



Sub sbRangeData()
With Sheets("Sheet1")
Set RngCol = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With
LastRow = RngCol.Rows.Count
Range("AE3:AE" & LastRow).Value = "780001"
Amountsort
End Sub
Sub Amountsort()
Range("X3", "X1500").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
Converttonumber
End Sub




Sub Converttonumber()


Range("A3:O2500").Select
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
FindAndReplace80391
End Sub






Sub FindAndReplace80391()


Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "80391" Then
Range("B" & i).Value = "10001"
End If
Next i
FindAndReplace130680
End Sub


Sub FindAndReplace130680()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "130680" Then
Range("B" & i).Value = "654001"
End If
Next i
FindAndReplace374747


End Sub


Sub FindAndReplace374747()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "374747" Then
Range("B" & i).Value = "10001"
End If
Next i
FindAndReplace80399


End Sub


Sub FindAndReplace80399()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "80399" Then
Range("B" & i).Value = "464001"
End If
Next i
FindAndReplace97065986
End Sub


Sub FindAndReplace97065986()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("A" & i).Value = "97065986" Then
Range("B" & i).Value = "84001"
End If
Next i
company
End Sub


Sub company()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("*Company", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("A3")
Else
MsgBox "Search Item Not Found!"
Exit Sub
End If
companycode
End Sub


Sub companycode()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Company Code", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("B3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
TradingPartner
End Sub


Sub TradingPartner()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Trading Partner", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("D3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
Reference
End Sub


Sub Reference()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Reference", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("E3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
Assignment
End Sub


Sub Assignment()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Assignment", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("F3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
DocumentNumber


End Sub


Sub DocumentNumber()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Number", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("G3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
DocumentType
End Sub


Sub DocumentType()


Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Type", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("H3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
DocumentDate
End Sub


Sub DocumentDate()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document Date", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("I3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
Account
End Sub


Sub Account()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Account", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("K3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
Amount
End Sub


Sub Amount()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Amount in doc. curr.", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("L3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
Documentcurrency
End Sub

Sub Documentcurrency()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet1")
Set fn = sh.Rows(2).Find("Document currency", , xlValues, xlWhole)
If Not fn Is Nothing Then
fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Upload").Range("M3")
Else
MsgBox "Search Item Not Found!"
Exit Sub

End If
change
End Sub
Sub change()
Dim sh As Worksheet
sh.Range("A2").Select
Nextsheet
End Sub
Sub Nextsheet()
ActiveSheet.Next.Activate


End Sub

-------------------------------------------

Once the amount in document currency is formatted to text to number i want the cursor point to go to sheet 1- A2
 
Last edited:
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Code:
[/COLOR][COLOR=#333333]Sub change()[/COLOR]
[COLOR=#333333]Dim sh As Worksheet[/COLOR]
[COLOR=#333333]Set sh = Sheets("Sheet1")
[/COLOR][COLOR=#333333]sh.Range("A2").Select[/COLOR]
[COLOR=#333333]Nextsheet[/COLOR]
[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]

 
Upvote 0
Hi Mart
Hope you are well.

I am trying to create a macro for sending emails from outlook. I have few edits to be done with the raw data for that i have given codes.

Since i m new to VBA i do not know how to use the Vlookup function. I am trying to get the data from Master data- Sheet name(Col A has Account & Col B has values). I want code to get the values of Col B if Col A in there in the Email output sheet.

Master Data sample


[TABLE="width: 141"]
<tbody>[TR]
[TD]Account[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]803[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]691[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]8010[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want to copy the values in the col I of the Email output sheet if the account number matches in the Col A.Can you help?

[TABLE="width: 902"]
<colgroup><col><col><col><col><col><col><col><col span="2"></colgroup><tbody>[TR]
[TD][TABLE="width: 434"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Col A[/TD]
[TD]Col I[/TD]
[/TR]
[TR]
[TD]Account[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD="align: right"]803[/TD]
[TD]Copy values from Master data depending on Account Value[/TD]
[/TR]
[TR]
[TD="align: right"]691[/TD]
[TD]Copy values from Master data depending on Account Value[/TD]
[/TR]
[TR]
[TD="align: right"]8010[/TD]
[TD]Copy values from Master data depending on Account Value[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,814
Messages
6,181,120
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top