Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 --------------- Jacob Skaria "TooN" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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" wrote: 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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Delete duplicates and add worksheet name
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 "Jacob Skaria" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 -- If this post helps click Yes --------------- Jacob Skaria "TooN" wrote: 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" wrote: 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 --------------- Jacob Skaria "TooN" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find duplicates, sum column then delete duplicates | Excel Programming | |||
Delete Duplicates | New Users to Excel | |||
how do i find and delete duplicates in excel worksheet? | Excel Discussion (Misc queries) | |||
delete duplicates macro to color instead of delete | Excel Programming | |||
delete duplicates | Excel Programming |