excel macro for advanced functions Closed

Question

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

rizvisa1 · Answer

Could you explain using sample book as example

rahul · Answer

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.

rahul · Answer

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 · Answer

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

Excel macro for advanced functions

4 responses

Similar discussions

Subscribe To Our Newsletter!