duplicate rows based on value - excel

Question

I have a code which goes trough a big database and checks for first 2 letters , if they answer a certain term they are getting replaced with certain integer ...
i want to duplicate the row which has "RE" as string in the first 2 letters and replace the "RE" to "821" and the duplicated row to "841"
Here is the code i have now..
Sub Swap()
Dim i As Long, N As Long, v As Variant, frst As String
Call deletes
Application.ScreenUpdating = False
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
v = Cells(i, "A").Value
If Len(v) >= 2 Then
frst = Left(v, 2)
If frst = "RE" Then
Cells(i, "A").Value = Replace(v, "RE", "821")
ElseIf frst = "NI" Then
Cells(i, "A").Value = Replace(v, "NI", "801")
ElseIf frst = "NF" Then
Cells(i, "A").Value = Replace(v, "NF", "831")
ElseIf frst = "NV" Then
Cells(i, "A").Value = Replace(v, "NV", "571")
End If
End If
Next i
End Sub

Answer 1

Multiple Replacements
The code is written in this way to allow different lengths of the strings to be searched for (Lens - Lengths Array). It is understood that the replacements can be of any 'allowed' length.
Adjust the values in the constants section. Also, rather qualify the range and its worksheet e.g.:
With ThisWorkbook.Worksheets("Sheet1").Range(FirstCellAddress)
The Code
Option Explicit
Sub Swap()
Const FirstCellAddress As String = "A2"
Const SrcList As String = "RE,NI,NF,NV"
Const FstList As String = "821,801,831,571"
Const SndList As String = "841,811,851,591"
' Define range.
Dim rg As Range
With Range(FirstCellAddress)
Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If rg Is Nothing Then Exit Sub
Set rg = .Resize(rg.Row - .Row + 1)
End With
' Write values from range to Data Array.
Dim rCount As Long: rCount = rg.Rows.Count
Dim Data As Variant
If rCount > 1 Then
Data = rg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
End If
' Write lists to arrays.
Dim Src() As String: Src = Split(SrcList, ",")
Dim Fst() As String: Fst = Split(FstList, ",")
Dim Snd() As String: Snd = Split(SndList, ",")
' Write lenghts of values in Search Array to Lengths Array.
Dim sUpper As Long: sUpper = UBound(Src)
Dim n As Long
Dim Lens() As Long: ReDim Lens(0 To sUpper)
For n = 0 To sUpper
Lens(n) = Len(Src(n))
Next n
' Define Unique Dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare ' '1' is used in 'StrComp' and 'Replace'.
Dim i As Long
Dim cValue As Variant
' Modify (replace) values in Data Array (using Unique Dictionary,
' test if first or second replacement is to be used).
For i = 1 To rCount
cValue = Data(i, 1)
If Not IsError(cValue) Then
For n = 0 To sUpper
If StrComp(Left(cValue, Lens(n)), Src(n), 1) = 0 Then
If dict.Exists(cValue) Then
Data(i, 1) = Replace(cValue, Src(n), Snd(n), , 1, 1)
Else
dict.Add cValue, Empty
Data(i, 1) = Replace(cValue, Src(n), Fst(n), , 1, 1)
End If
Exit For
End If
Next n
Else ' error value
End If
Next i
Set dict = Nothing
' Write modified values from Data Array to range.
rg.Value = Data
End Sub