Delete duplicates and add worksheet name

[TooN]

Hello Programmers..

I have a problem with some macro's i found. I have been searching for day's
now but could not find a good solution for my problem. A lot of threads are
almost good but because of my low knowledge of programming i am not able to
adjust the macro according to my needs.

First i will explain the situation:
I have a excel sheet with about 20 worksheets. There are two "intro" sheets
with all sorts of information (they called "info" and "archive") The rest of
the sheets are project related sheets. In these project related sheets are
about 20 columns and 50 rows. The data that are in these sheets are a
download from SAP.

Problem:
The download contains duplicate numbers in column J.

Solution:
I found a few macro's that are almost good:
-------------------------------------------------------------------
Sub DeleteDuplicates()

Dim X As Long
Dim lastrow As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets


lastrow = Range("J65536").End(xlUp).Row
For X = lastrow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("J1:J" & X),
Range("J" & X).Text) > 1 Then
Range("J" & X).EntireRow.Delete
End If

On Error Resume Next 'Will continue if an error results
ws.Range("A1") = ws.Name

'***********************
Next X
Next ws

End Sub
-------------------------------------------------------------------

The above macro will delete all the duplicates BUT it is NOT looping through
all the the worksheets in my workbook (except for the two mentioned above).

What is wrong with my macro??? I would also (if its possible) like to add
the worksheetname automaticly according to input of Cell A10

I would apreciate if someone can help me!

Thanks

 

[Jacob Skaria]

Try the below

Sub DeleteDuplicates()
Dim X As Long
Dim lastrow As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) <> "INFOR" And UCase(ws.Name) <> "ARCHIVE" Then
lastrow = ws.Range("J65536").End(xlUp).Row
For X = lastrow To 1 Step -1
If Application.WorksheetFunction.CountIf(ws.Range("J1:J" & X), _
ws.Range("J" & X).Text) > 1 Then ws.Range("J" & X).EntireRow.Delete
On Error Resume Next
Next X
ws.Range("A1") = ws.Name
End If
Next ws

End Sub


If this post helps click Yes

 

[TooN]

Hello Jacob,

Thanks for the quick response. It works almost perfect. There is only one
thing not yet working. I saw that the sheetname is copied to cell A1. I want
to give the sheetname the same name as Cell A10 in that specific sheet. So if
cell A10 has the value "Project123" than the sheetname should have the name
"Project123"

Thanks.

 

[Jacob Skaria]

Try the below. Make sure Range("A10") of sheets are not blank or contain any
special characters like /, \ etc'

Sub DeleteDuplicates()
Dim X As Long
Dim lastrow As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) <> "INFOR" And UCase(ws.Name) <> "ARCHIVE" Then
lastrow = ws.Range("J65536").End(xlUp).Row
For X = lastrow To 1 Step -1
If Application.WorksheetFunction.CountIf(ws.Range("J1:J" & X), _
ws.Range("J" & X).Text) > 1 Then ws.Range("J" & X).EntireRow.Delete
On Error Resume Next
Next X
ws.Range("A1") = ws.Name
ws.Name = ws.Range("A10")
End If
Next ws

End Sub

 

[TooN]

Jacob,

one small last request. Is it possible to NOT change the name of the sheets
"INFOR" and "ARCHIVE" (same that in the macro will be skipped)

Thanks in advance!

 

[Jacob Skaria]

The current macro does that..The below line exclude these two sheets from
being renamed and from being deleted...

If UCase(ws.Name) <> "INFOR" And UCase(ws.Name) <> "ARCHIVE" Then

If this post helps click Yes

 

[TooN]

Jacob,

Sorry i missed that... you are wright, but it only skippes the INFOR sheet,
the other one is still renaming. Could it be that i am doing something wrong?

 

[Jacob Skaria]

Check whether the sheet name is exacly as mentioned or contain any
spaces...If so remove the spaces

OR

If Trim(UCase(ws.Name)) <> "INFOR" And trim(UCase(ws.Name)) <> "ARCHIVE" Then

If this post helps click Yes

 

[TooN]

Jacob.... thanks for your time. The reason it was still changing because it
is also capital sensitive so ARCHIVE works bur Archive is not working....
anyway, got it working now!

Thanks