Shaun: This is not as simple to do as it is to say, but it can be done.
However, I would like a copy of one or more reports to see how it is laid
out. I also work for a cable company and have written many Excel programs
that help us out with AS400 reports. I have an idea that may work for your
problem, but seeing the data in the raw would help immensely.
Mike F
"shaun nieves " wrote in
message ...
Hello all, I'm new here and I hope somebody can help me out. I'm trying
to figure out how to compare and delete data using a macro in excel. I
have a workbook with 2 sheets. One sheet contains disconnected rate
info for accounts. The other sheet contains install info for accounts.
Here is the problem. This is a commission report. We have an issue with
our billing system that in order to add services to an account that has
a campaign associated with it, our agents have to take services off of
the account to "break" the campaign. They complete the work order then
start a new one putting the existing services back on and then adding
the new services. Unfortunately, the query pulls all of that data and
it looks like the agent sold more services then they actually did. The
result would be the agent getting paid more than they should.
What i'm trying to do is create a macro that will compare the
disconnect and install sheets. If a row in the install sheet matches
the row in the disconnect sheet, delete the row and move onto the next
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 to
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/