Overwrite & Distribute Values - excel

Question

There are around 1000 different "customer_ids" in total. These can also occur several times in the file on several worksheets.
The "customer_id" data records should be automatically overwritten with a new name. The designation represents a format consisting of a fixed sequence of letters + a consecutive, ascending number -> ABC1, ABC2, ..., ABCn. See figure above left.
The name of the row-header and its position can be different in the worksheets. This means that the "customer_id" can also be found as "cust_id" in columns other than "A". See figures.
The recurring customer_id's should have the same name on all worksheets, see figures.

Answer 1

Please, test the next (working) solution:
Edited:
Please, try the next version (using arrays) which should be much faster:
Option Explicit
Sub ChangeIDPart2()
Const idBaseName As String = "ABC"
Const ColNamesList As String = "customer_id,cust_id" ' add more
Const HeaderRow As Long = 1
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim fRow As Long: fRow = HeaderRow + 1
Dim ColNames() As String: ColNames = Split(ColNamesList, ",")
Dim cUpper As Long: cUpper = UBound(ColNames)
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare ' ignore case of 'idBaseName'
Dim ws As Worksheet ' Current Worksheet
Dim rrg As Range ' Entire Row of Headers
Dim arr As Variant ' ID Column Range array (changed...)
Dim cCell As Range ' Current Cell in ID Column Range
Dim cIndex As Variant ' Current ID Column (could be an error value)
Dim Key As Variant ' Current ID (string)
Dim lRow As Long ' ID Column Last Non-Empty (Not Hidden) Row
Dim n As Long ' New ID Incrementer
Dim i As Long ' Column Names (Titles, Headers) Counter
Dim foundHeader As Boolean ' Found Header Boolean
For Each ws In wb.Worksheets
fRow = HeaderRow + 1
Set rrg = ws.Rows(HeaderRow)
For i = 0 To cUpper
cIndex = Application.Match(ColNames(i), rrg, 0)
If IsNumeric(cIndex) Then
foundHeader = True
Exit For
End If
Next i
If Not foundHeader Then
Dim k As Long
For k = 1 To 5
Set rrg = ws.Rows(HeaderRow + k)
For i = 0 To cUpper
cIndex = Application.Match(ColNames(i), rrg, 0)
If IsNumeric(cIndex) Then
fRow = rrg.row + 1
foundHeader = True
Exit For
End If
Next i
If foundHeader Then Exit For
Next k
End If
If Not foundHeader Then MsgBox "In sheet " & ws.Name & _
" an appropriate header could not be found in first 6 rows..."
If foundHeader Then
foundHeader = False ' reset
lRow = ws.Cells(ws.Rows.Count, cIndex).End(xlUp).Row
If lRow > 1 Then ' check if any id's
arr = ws.Range(ws.Cells(fRow, cIndex), _
ws.Cells(lRow, cIndex)).Value 'put the range in array (to iterate faster)
For i = 1 To UBound(arr)
Key = CStr(arr(i, 1))
If Key <> "" Then
If Not dict.Exists(Key) Then
n = n + 1
dict.Add Key, idBaseName & n
End If
arr(i, 1) = dict(Key)
End If
Next i
ws.Range(ws.Cells(fRow, cIndex), _
ws.Cells(lRow, cIndex)).Value = arr 'drop back in the range the processed array
End If
End If
Next ws
MsgBox "Done.", vbInformation, "Change ID Part 2"
End Sub
Please, test it and send some feedback. I am curious how much it takes. Theoretically, it should be obviously faster.