PDA

View Full Version : Solved: Add a count variable & increment it appropriately in this code



rangudu_2008
05-06-2008, 07:50 AM
I need to have a count variable (called cnt) and increment it in the DupMarker function inorder to display the no. of duplicates found in the Duplicates module. How can the cnt variable be incremented appropriately?
Plz comment out the newly added code (in CAPS).

I need a solution urgently in 2 hrs. time. Can anyone help me out?

figment
05-06-2008, 08:37 AM
sorry i dont have the time to write the code, but it looks like you have all the duplicates rows marked with a "1" at some point in your code. if this is so then all you need to do is take a sum of that column befor you delete the duplicats, and you will know how many there are.

Bob Phillips
05-06-2008, 08:43 AM
MsgBox Application.Sum(Columns(13))
Cells(1, 12).EntireColumn.Delete
Cells(1, 13).EntireColumn.Delete

rangudu_2008
05-06-2008, 09:25 AM
Thanks a lot... It works fine

rangudu_2008
05-10-2008, 07:53 PM
I've included the code to display the count of variables in the code as below:



Function DupMarker(TargetColumn As Range)
Dim lLastRow As Long
Dim lLastCol As Long
'Check if multiple columns provided and exit if so
If TargetColumn.Columns.Count <> 1 Then Exit Function
With TargetColumn.Parent
'Determine last row and last column
lLastRow = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lLastCol = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'Set up an index column of ascending numbers after the last column
.Cells(5, lLastCol + 1).Value = 1
.Range(.Cells(6, lLastCol + 1), .Cells(lLastRow, lLastCol + 1)).FormulaR1C1 = "=R[-1]C+1"
.Columns(lLastCol + 1).Cells.Copy
.Columns(lLastCol + 1).Cells.PasteSpecial Paste:=xlValues
'Sort the records by the column specified in ascending order
.Range(.Cells(5, 1), .Cells(lLastRow, lLastCol + 1)).Sort _
Key1:=TargetColumn, Order1:=xlAscending, _
Key2:=.Columns(lLastCol + 1)
'Set up an formula column at end to determine if each rows record matches
'the previous rows record. If so, mark it 0, otherwise 1
.Cells(5, lLastCol + 2).Value = 0
.Range(.Cells(6, lLastCol + 2), .Cells(lLastRow, lLastCol + 2)).FormulaR1C1 = _
"=if(RC[" & TargetColumn.Column - (lLastCol + 2) & "]=R[-1]C[" & TargetColumn.Column - (lLastCol + 2) & "],1,0)"
.Columns(lLastCol + 2).Cells.Copy
.Columns(lLastCol + 2).Cells.PasteSpecial Paste:=xlValues
'Sort the records by the match column.
'Eliminates complex ranges in large data sets that create errors
.Range(.Cells(5, 1), .Cells(lLastRow, lLastCol + 2)).Sort Key1:=.Cells(5, lLastCol + 2)
'Autofilter and delete all cells showing a 1 as they are duplicate values
With .Range(.Cells(5, 1), (.Cells(lLastRow, lLastCol + 2)))
.AutoFilter
.AutoFilter field:=lLastCol + 2, Criteria1:="1"
End With
On Error GoTo NoDup
.Range(.Cells(6, 1), .Cells(lLastRow, lLastCol + 2)).SpecialCells(xlCellTypeVisible).Font.Color = RGB(255, 0, 0)
.AutoFilterMode = False
'Resort the data back to the original order
.Range(.Cells(5, 1), .Cells(.Rows.Count, lLastCol + 2).End(xlUp)).Sort _
Key1:=.Cells(5, lLastCol + 1)
End With
' COUNT OF DUPLICATES
MsgBox Application.Sum(Columns(13)) & " duplicate(s) found", vbInformation, "Duplicates Found"

' Code needs to be placed here



Cells(1, 12).EntireColumn.Delete
Cells(1, 13).EntireColumn.Delete
NoDup:
With TargetColumn.Parent
.AutoFilterMode = False
End With
Cells(1, 12).EntireColumn.Delete
Cells(1, 13).EntireColumn.Delete
If Err.Number = 1004 Then
MsgBox "No Duplicate IDs Found", vbInformation, "No Duplicates"
Exit Function
End If
End Function


Now i need to apply filter thru code to display the duplicates alone to the user. This needs to be done before the coulmns 12 and 13 are deleted.

How can this be done?