Macro code to check duplicate in excel column,Blank all Worksheets

Macro code to check duplicate in excel column

This is simple Macro code example to check duplicate in excel column. If you have very long list data in single column and have lot of duplicate or redundant data then its headache to find duplicate value.

By using following code tricks you can find it easily in excel.

 Function LastRow(ByVal Filename As String) As Long  
 Dim ix As Long  
 ix = Worksheets(Filename).UsedRange.Row - 1 + Worksheets(Filename).UsedRange.Rows.Count  
 ' ix = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
 LastRow = ix  
 End Function  
 Function LastCol(ByVal Filename As String) As String  
 Dim ix As Integer  
 ix = Worksheets(Filename).UsedRange.Column - 1 + Worksheets(Filename).UsedRange.Columns.Count  
 LastCol = ConvertToLetter(ix)  
 End Function  
 Function ConvertToLetter(iCol As Integer) As String  
 ' Dim iAlpha As Integer  
 ' Dim iRemainder As Integer  
 ' iAlpha = Int(iCol / 27)  
 ' iRemainder = iCol - (iAlpha * 26)  
 ' If iAlpha > 0 Then  
 ' ConvertToLetter = Chr(iAlpha + 64)  
 ' End If  
 ' If iRemainder > 0 Then  
 ' ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)  
 ' End If  
 Dim columnName As String  
 Dim modulo As Integer  
 While iCol > 0  
 modulo = (iCol - 1) Mod 26  
 columnName = Chr(65 + modulo) + columnName  
 iCol = Int((iCol - modulo) / 26)  
 Wend  
 ConvertToLetter = columnName  
 End Function  
 Function ColumnRange(ByVal Filename As String, ByVal Rangehead As String) As String  
 Dim r As Range  
 Dim ic As Integer  
 Dim rt As String  
 Dim CN As String  
 Set r = Worksheets(Filename).Range("A1:" & LastCol(Filename) & "1")  
 For i = 1 To r.Count  
 If Rangehead = r(1, i) Then  
 ic = i  
 i = r.Count  
 End If  
 Next  
 If ic = 0 Then  
 rt = ""  
 Else  
 CN = ConvertToLetter(ic)  
 rt = CN & "2:" & CN & LastRow(Filename)  
 End If  
 ColumnRange = rt  
 End Function  
 Sub configs(ByVal Target As Range)  
 Dim Flag As Boolean  
 Dim strcmp As String  
 Flag = False  
 Dim NOCalc As Boolean  
 NOCalc = False  
 For i = 1 To LastRow("exppk")  
 If Target.Address = ("$A$" & i) Then  
 Dim rng As Range  
 Set rng = Worksheets("exppk").Range("$A$" & i)  
 strcmp = rng(1, 1)  
 If strcmp = "Error" Then  
 NOCalc = True  
 End If  
 Flag = True  
 i = LastRow("exppk") + 1  
 End If  
 Next i  
 If NOCalc Then  
 Else  
 If Flag Then  
 i = LastRow("exppk") + 1  
 For j = 1 To LastRow("exppk")  
 Dim Rg As Range  
 Set Rg = Worksheets("exppk").Range("$A$" & j)  
 If Target.Address <> ("$A$" & j) Then  
 If strcmp = Rg(1, 1) Then  
 rng(1, 1).Value = "Error"  
 j = LastRow("exppk") + 1  
 End If  
 End If  
 Next j  
 End If  
 End If  
 End Sub  

Code to blank all sheets in excel

If you have lot of things written in sheet and want to blank or clear that worksheet then you can try this micro code.

 Sub BlankAll()  
 Dim BlankSh As Worksheet  
 Application.DisplayAlerts = False  
 On Error Resume Next  
 ActiveWorkbook.Worksheets("Blank").Delete  
 On Error GoTo 0  
 Application.DisplayAlerts = True  
 Set BlankSh = ActiveWorkbook.Worksheets.Add  
 BlankSh.Name = "Blank"  
 For Each sh In ActiveWorkbook.Worksheets  
 If InStr(sh.Name, "Blank") Then  
 Else  
 Application.DisplayAlerts = False  
 On Error Resume Next  
 ActiveWorkbook.Worksheets(sh.Name).Delete  
 On Error GoTo 0  
 Application.DisplayAlerts = True  
 End If  
 Next  
 End Sub