v_gyku
09-09-2005, 05:41 AM
I have written a code that finds the duplicate rows in an excel sheet and highlights rows.
I have a problem if all the sheets dont have duplicate rows then i want to disaply a messagebox that workbook dont have duplicate rows.
I am trying to use a variable nodata. plz if u can cont.. with it....
Dim nodata As Integer
nodata = 0
Dim objrange As Excel.Range
Dim Row1 As Range, Row2 As Range
Dim Col1 As Range, Col2 As Range
Dim NewStr1 As String, Newstr2 As String
Dim highlight As Boolean
'Needs reference to Microsoft Scripting Runtime
Dim MyDic As Dictionary
Set MyDic = New Dictionary
Application.ScreenUpdating = False
For Each Row1 In objworksheet.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(objworksheet.Rows(Row1.Row)) > 0 Then
NewStr1 = "Sheet1"
For Each Col1 In objworksheet.UsedRange.Columns
NewStr1 = NewStr1 & "||" & objworksheet.Cells(Row1.Row, Col1.Column)
Next
If MyDic.Exists(NewStr1) Then
'Colour intra sheet duplicates in sheet 1 as blue
objworksheet.Rows(Row1.Row).Interior.Color = vbYellow
objworksheet.Rows(MyDic(NewStr1)).Interior.Color = vbYellow
highlight = True
Else
MyDic.Add NewStr1, Row1.Row
End If
End If
Next
Application.ScreenUpdating = True
Set MyDic = Nothing
'Set objworksheet = Nothing
On Error GoTo 0
'Re-protect protected sheet
If sheetProtected = True And cancelPwd = False Then
objworksheet.Protect (sheetPassword)
End If
Next objworksheet
'Minimize the Excel window
ObjExcel.WindowState = xlMinimized
If nodata = 3 Then
highlight = False
End If
End If
' 'Minimize the Excel window
' ObjExcel.WindowState = xlMinimized
If highlight = True Then
MsgBox "The duplicate rows in the """ & myFile & """ workbook have been highlighted.", _
vbOKOnly, "RightAnswers"
Else
MsgBox "Duplicate rows were not found in the """ & myFile & """ workbook.", _
vbOKOnly, "RightAnswers"
intFileErrors = intFileErrors + 1
strFileErrors = strFileErrors & myFile & vbCrLf
End If
Objworkbook.Save
Objworkbook.Close
Set Objworkbook = Nothing
ObjExcel.Quit
End If
End If
Exit Sub
I have a problem if all the sheets dont have duplicate rows then i want to disaply a messagebox that workbook dont have duplicate rows.
I am trying to use a variable nodata. plz if u can cont.. with it....
Dim nodata As Integer
nodata = 0
Dim objrange As Excel.Range
Dim Row1 As Range, Row2 As Range
Dim Col1 As Range, Col2 As Range
Dim NewStr1 As String, Newstr2 As String
Dim highlight As Boolean
'Needs reference to Microsoft Scripting Runtime
Dim MyDic As Dictionary
Set MyDic = New Dictionary
Application.ScreenUpdating = False
For Each Row1 In objworksheet.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(objworksheet.Rows(Row1.Row)) > 0 Then
NewStr1 = "Sheet1"
For Each Col1 In objworksheet.UsedRange.Columns
NewStr1 = NewStr1 & "||" & objworksheet.Cells(Row1.Row, Col1.Column)
Next
If MyDic.Exists(NewStr1) Then
'Colour intra sheet duplicates in sheet 1 as blue
objworksheet.Rows(Row1.Row).Interior.Color = vbYellow
objworksheet.Rows(MyDic(NewStr1)).Interior.Color = vbYellow
highlight = True
Else
MyDic.Add NewStr1, Row1.Row
End If
End If
Next
Application.ScreenUpdating = True
Set MyDic = Nothing
'Set objworksheet = Nothing
On Error GoTo 0
'Re-protect protected sheet
If sheetProtected = True And cancelPwd = False Then
objworksheet.Protect (sheetPassword)
End If
Next objworksheet
'Minimize the Excel window
ObjExcel.WindowState = xlMinimized
If nodata = 3 Then
highlight = False
End If
End If
' 'Minimize the Excel window
' ObjExcel.WindowState = xlMinimized
If highlight = True Then
MsgBox "The duplicate rows in the """ & myFile & """ workbook have been highlighted.", _
vbOKOnly, "RightAnswers"
Else
MsgBox "Duplicate rows were not found in the """ & myFile & """ workbook.", _
vbOKOnly, "RightAnswers"
intFileErrors = intFileErrors + 1
strFileErrors = strFileErrors & myFile & vbCrLf
End If
Objworkbook.Save
Objworkbook.Close
Set Objworkbook = Nothing
ObjExcel.Quit
End If
End If
Exit Sub