Excel macro for advanced functions

Closed
rahul - Jun 1, 2010 at 07:36 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 2, 2010 at 10:26 AM
Hello,

Attached is a sample Excel file in the below link

https://authentification.site/files/22733903/CD1S.csv

The duplicates needs to removed with the following conditions:
1. There are a number of addresses (the IO address field) that appear more than once.
2. %L addresses will appear as duplicates but should not be deleted.

3. Need to rename variables (except %L) that have a block name in front of it. Get rid of the block name. Example, you may have a variable named TEMP2.M00008 to be named M00008.
4. All the %M variables under retentive state coloumn to be set to "NO".


Also Need a script that will strip these out of the CSV file and update the names and the retentive state (keeping the existing variables in the same order). Also it will show a report that shows what is being deleted.

Can anyone please guide me in the same as its urgent
Related:

4 responses

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jun 1, 2010 at 05:22 PM
Could you explain using sample book as example
HI Riz,,

If you look at my previous attached excel spread sheet.

The Script should basically delete all the duplicates rows occuring under Row P except for the addresses which starts with %L and then it should copy the the same deleted duplicate rows in a new spread sheet.

Also the script should remove all the names Under row A which appears before the . symbol except for the ones which has Characted .L

for example TEMP2.M00008 to be named as M00008.
. TEMP2.L00008 should be kept as TEMP2.L00008.
I did start with th script which looks like this but doesnt seem to to ignore the the duplicates which starts with %L under ROW P

Also the script does not copy the deleted duplicate rows in a new spread sheet.

Sub Macro1()
Application.ScreenUpdating = False

Columns("P:P").Select
Selection.AutoFilter
ActiveSheet.Range("$P$1:$P$65500").AutoFilter Field:=1, Criteria1:="<>*%L*", _
Operator:=xlAnd

LastRow = Range("P65500").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("P1:P" & x), Range("P" & x).Text) > 1 Then
Range("P" & x).EntireRow.Delete
End If
Next x

Selection.AutoFilter



ActiveSheet.Range("$A$1:$A$65500").AutoFilter Field:=1, Criteria1:="<>*.L*", _
Operator:=xlAnd, Criteria2:="<>ETHRSUB.*"


Dim rSrchRng As Range, rFound As Range
Dim sFind As String

sFind = "."

Set rSrchRng = Range("A1", Range("A" & Rows.Count).End(xlUp))
Do
Set rFound = rSrchRng.Find(What:=sFind, LookIn:=xlValues)
If Not rFound Is Nothing Then

rFound.Value = Trim(Split(rFound, ".")(1))

End If
Loop Until rFound Is Nothing

Selection.AutoFilter

End sub

Can you please me in the same.
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jun 2, 2010 at 10:26 AM
Try this. A word of warning. On my PC it took a long time to run. I wonder if that has to do with %

Here is the logic of the code.

1. First in a temp column Identify the count the occurrence of value of the cell in P column by using countif. The logic of count if is
a. if the cell starts with %L then make count as 0
b. Count the occurence of the cell in column P on the row being inspected from top till that row.

2. Filter on count >1. This will show all duplicated values. Since we had done count till inspected row, the first occurrence of the value would have a count of 1

3. Copy the duplicated value of a new sheet

4. delete the rows filtered

5. remove the filter

6. then change the names in column A based on logic
a. if cell has ".L", then ignore the cell
b. If the cell does not have a "." then ignore the cell
c. if the cell has a . and is not a .L, then extract the value after .

Sub fixMe()
Dim sMasterSheet As String
Dim sRemovedData As String
Dim lMaxRows As Long
Dim lMaxRows1 As Long
Dim iMaxCols As Integer

    sMasterSheet = "CD1S"
    sRemovedData = "Deleted Items"
    
    On Error Resume Next
        Sheets(sRemovedData).Delete
    On Error GoTo 0
    
    Sheets.Add
    ActiveSheet.Name = sRemovedData
    
    Sheets(sMasterSheet).Select
    
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    
    lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    iMaxCols = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    Cells(1, iMaxCols + 1) = "Temp Col"
    
    With Range(Cells(2, iMaxCols + 1), Cells(lMaxRows, iMaxCols + 1))
    
        .FormulaR1C1 = "=IF(LEFT(RC16, 2) = ""%L"", 0,CountIF(R1C16:RC16, ""="" & RC16))"
        .Copy
        .PasteSpecial xlPasteValues
        
    End With
    
    Cells.Select
    Selection.AutoFilter
    
    'Cells.AutoFilter Field:=16, Criteria1:="<>%L*"
    Cells.AutoFilter Field:=iMaxCols + 1, Criteria1:=">1"
    
    lMaxRows1 = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    If (lMaxRows1 > 1) Then
        
        Range(Cells(1, 1), Cells(lMaxRows1, iMaxCols)).Copy
        Sheets(sRemovedData).Select
        Range("A1").Select
        ActiveSheet.Paste
        Sheets(sMasterSheet).Select
        Rows("2:" & lMaxRows1).Delete
        
        ActiveSheet.AutoFilterMode = False
        
    End If
    
    lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With Range(Cells(2, iMaxCols + 1), Cells(lMaxRows, iMaxCols + 1))
    
        .FormulaR1C1 = "=MID(RC1,1 + IF(ISERROR(FIND("".L"",RC1,1)), IF(ISERROR(FIND(""."",RC1, 1)),0, FIND(""."",RC1,1)),0), LEN(RC1))"
        .Copy
        Range("A2").Select
        .PasteSpecial xlPasteValues
        .Clear
        Cells(1, iMaxCols + 1).Clear
    End With
    

End Sub