Renaming duplicate column names

SUBHASHn · Dec 9th 2020

Any way to fix it?

Mumps · Dec 9th 2020

Do you have any blank cells in column A?

SUBHASHn · Dec 9th 2020

In original file the data is in column B so changed it accordingly as below.

SUBHASHn · Dec 9th 2020

No blank cells

Mumps · Dec 9th 2020

I tried the macro on the file you posted after moving the data to column B, and it worked properly. The error you got indicates that there is no filtered data to analyze. This makes no sense because the filter criteria is taken from the array which was created using the existing data in column B so there should always be data visible after the filtering is done. The only thing I can suggest is that you post a copy of your actual file, de-sensitized if necessary) so that I can test the macro on the actual data.

dangelor · Dec 9th 2020

Quote from SUBHASHn

Can I skip 6-11 lines of the code as it is taking lot of time and the excel I have has 80k rows

I see you've moved on , but this is a reply to post #15. It may be a little quicker...

Code

Sub Rename_v2()
    Dim lRow As Long, rg As Range
    Dim v As Variant, k As Variant
    Dim i As Long, j As Long, x As Long
    
    Application.ScreenUpdating = False
    With Sheet1
        lRow = .Cells(Rows.Count, 7).End(xlUp).Row
        Set rg = Sheet1.Range("g2:g" & lRow)
        v = Application.Transpose(rg)
        
        With CreateObject("Scripting.Dictionary")
            For Each k In v
                .Item(k) = Empty
            Next k
            k = .keys
        End With
        
        v = rg.Resize(, 2)
        For i = LBound(k) To UBound(k)
            x = 0
            For j = LBound(v) To UBound(v)
                If k(i) = v(j, 1) Then
                    x = x + 1
                    v(j, 2) = Replace(k(i), ".", x & ".")
                End If
            Next j
        Next i
    End With
    rg.Resize(, 2) = v
    Application.ScreenUpdating = True
End Sub

Display More

SUBHASHn · Dec 9th 2020

One last question @ Mumps will it impact the code if there is some data in column A?

Mumps · Dec 9th 2020

No, it shouldn't.

SUBHASHn · Dec 9th 2020

Hi @ dangelor thanks for the code if there is any duplicate it has to add _1.pdf,_2.pdf to it...in the above code it is adding A11.pdf,A22.pdf it should be like A1_1.pdf and A2_2.pdf

dangelor · Dec 9th 2020

Added the dash...

Code

Sub Rename_v2()
    Dim lRow As Long, rg As Range
    Dim v As Variant, k As Variant
    Dim i As Long, j As Long, x As Long
        
    Application.ScreenUpdating = False
    lRow = Sheet1.Cells(Rows.Count, 7).End(xlUp).Row
    Set rg = Sheet1.Range("g2:g" & lRow)
    v = Application.Transpose(rg)
    
    With CreateObject("Scripting.Dictionary")
        For Each k In v
            .Item(k) = Empty
        Next k
        k = .keys
    End With
    
    v = rg.Resize(, 2)
    For i = LBound(k) To UBound(k)
        x = 0
        For j = LBound(v) To UBound(v)
            If k(i) = v(j, 1) Then
                x = x + 1
                v(j, 2) = Replace(k(i), ".", "_" & x & ".")
            End If
        Next j
    Next i
    rg.Resize(, 2) = v
    Application.ScreenUpdating = True
End Sub

Display More

SUBHASHn · Dec 9th 2020

Hi dangelor it adding add " _" for all the cells...it should only add it to the duplicates..In the below I have highlighted the duplicate with yellow which is correct if there is no duplicate it should keep the same

SUBHASHn · Dec 9th 2020

Here it is adding+1 to all the cells

SUBHASHn · Dec 9th 2020

it should be like this

dangelor · Dec 10th 2020

Try...

Code

Sub Rename_v3()
    Dim lRow As Long, rg As Range
    Dim v As Variant, k As Variant
    Dim i As Long, j As Long, x As Long

    Application.ScreenUpdating = False
    lRow = Sheet1.Cells(Rows.Count, 7).End(xlUp).Row
    Set rg = Sheet1.Range("g2:g" & lRow)
    v = Application.Transpose(rg)
    
    With CreateObject("Scripting.Dictionary")
        For Each k In v
            .Item(k) = Empty
        Next k
        k = .keys
    End With
    
    v = rg.Resize(, 2)
    For i = LBound(k) To UBound(k)
        x = 0
        For j = LBound(v) To UBound(v)
            If k(i) = v(j, 1) Then
                    x = x + 1
                If x > 1 Then
                    v(j, 2) = Replace(k(i), ".", "_" & x - 1 & ".")
                Else
                    v(j, 2) = k(i)
                End If
            End If
        Next j
    Next i
    rg.Resize(, 2) = v
    Application.ScreenUpdating = True
End Sub

Display More

SUBHASHn · Dec 10th 2020

Hi again, the actual data is in column B and I changed 7 to 2 and g2:g to b2:b but Iam getting this error.

dangelor · Dec 10th 2020

What error and on which line of code?

SUBHASHn · Dec 10th 2020

Here I am opening the actual file from seperate macro file...the error is highlighted here

dangelor · Dec 10th 2020

...and the error is???

dangelor · Dec 10th 2020

Try this version...

Code

Sub Rename_v5()
    Dim lRow As Long, rg As Range
    Dim v As Variant, k As Variant
    Dim i As Long, j As Long, x As Long

    Application.ScreenUpdating = False
    
    With Workbooks.Open(Filename:="C:\BP\Input.xlsx").Worksheets("Sheet1") '''Change worksheet name as needed'''
        lRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set rg = .Range("a2:a" & lRow)
    End With
    
    v = Application.Transpose(rg)
    
    With CreateObject("Scripting.Dictionary")
        For Each k In v
            .Item(k) = Empty
        Next k
        k = .keys
    End With
    
    v = rg.Resize(, 2)
    For i = LBound(k) To UBound(k)
        x = 0
        For j = LBound(v) To UBound(v)
            If k(i) = v(j, 1) Then
                x = x + 1
                If x > 1 Then
                    v(j, 2) = Replace(k(i), ".", "_" & x - 1 & ".")
                Else
                    v(j, 2) = k(i)
                End If
            End If
        Next j
    Next i
    rg.Resize(, 2) = v
    Application.ScreenUpdating = True
End Sub

Display More

SUBHASHn · Dec 10th 2020

To save the workbook what should be the line of code before End sub?

Renaming duplicate column names

Participate now!

Share