Hello all, I'm new here and I hope somebody can help me out. I'm tryin
to figure out how to compare and delete data using a macro in excel.
have a workbook with 2 sheets. One sheet contains disconnected rat
info for accounts. The other sheet contains install info for accounts


Here is the problem. This is a commission report. We have an issue wit
our billing system that in order to add services to an account that ha
a campaign associated with it, our agents have to take services off o
the account to "break" the campaign. They complete the work order the
start a new one putting the existing services back on and then addin
the new services. Unfortunately, the query pulls all of that data an
it looks like the agent sold more services then they actually did. Th
result would be the agent getting paid more than they should.

What i'm trying to do is create a macro that will compare th
disconnect and install sheets. If a row in the install sheet matche
the row in the disconnect sheet, delete the row and move onto the nex
row.

Here is a sample of the sheets.

Disconnect:
Acct:------ Rate CD-- Agent----- Quantity from-------- Quantity to
2967801- DIGCNV-- Agent----- 1------------------------0
2967801- DIGCNV-- Agent----- 1------------------------0
2967801- DIGTIER-- Agent----- 1------------------------0
2967801- DIGTIER-- Agent----- 1------------------------0
2967801- EXPD----- Agent----- 1------------------------0
2967801- EXPD----- Agent----- 1------------------------0
2967801- HBOMAX-- Agent----- 1------------------------0
2967801- HBOMAX-- Agent----- 1------------------------0
2967801- PLDIGPK- Agent----- 1------------------------0

Install:
Acct:------ Rate CD-- Agent----- Quantity from-------- Quantity to
2967801- DIGCNV-- Agent----- 0------------------------1
2967801- DIGCNV-- Agent----- 0------------------------1
2967801- EXPD----- Agent----- 0------------------------1
2967801- HBOMAX-- Agent----- 0------------------------1
2967801- PLBGRFH- Agent----- 0------------------------1
2967801- TIERFAM-- Agent----- 0------------------------1
2967801- TIERFAM-- Agent----- 0------------------------1

In the above example we would only pay on the TIERFAM.

I've tried this compare macro to compare the data but and very new t
this so I don't know how to add the syntax to delete the duplicates.

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count 1
Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
With ws1.UsedRange
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With ws2.UsedRange
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & Format(c / maxC
"0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 < cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " < " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different formulas!",
vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

I hope this was a thorough enough explanation of my dilema. I'm going
to keep searching for an answer but if someone can give me any kind of
guidance I would be extremely appreciative!

Thanks in advance




---
Message posted from http://www.ExcelForum.com/