Replace a character string with other characters in column "K"

[harzer]

Hello everyone,
I have a code which should normally replace certain characters (in column "K") with other characters, but it is impossible to make it work, where is the problem?
Unless I'm mistaken, the correct result is in column "N".
Thank you for your propositions.

Sub remplacer_Chaines()

    Dim ws As Worksheet
    Dim arrReplace As Variant
    Dim strReplacement As String
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Parents")

    arrReplace = Array(, "elevé", "Hty27", "hty27", "Hwa96", "hwa96", "cage")
    For i = LBound(arrReplace) To UBound(arrReplace)

        Select Case arrReplace(i)
            Case "elevé"
                strReplacement = "Elevé"
            Case "Hty27", "hty27"
                strReplacement = "HTY27"
            Case "Hwa96", "hwa96"
                strReplacement = "HWA96"
            Case "cage"
                strReplacement = "Cage"

        End Select

        ws.Columns("K").Replace What:=arrReplace(i), Replacement:=strReplacement, LookAt:=xlWhole, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Next i

End Sub

Code_Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Jeune+N46A1:N44	Père	Mère	Eleveur	Âge	Volière	Cage	Né(e)	Tours	Couleur	Elevage	Consanguinité	ancêtre principale	Résultat
2	*	*	*	*	*	*	*	*	*	*	elevé/hty27-017/23 cage 12	*	*	Elevé/HTY27-017/23 Cage 12
3	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-017/23 cage 12X	*	*	Elevé/HTY27-017/23 Cage 12X
4	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-017/23 Cage 12 X	*	*	Elevé/HTY27-017/23 Cage 12 X
5	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-017/23 cage 12	*	*	Elevé/HTY27-017/23 Cage 12
6	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-023/23 cage 8	*	*	Elevé/HTY27-023/23 Cage 8
7	*	*	*	*	*	*	*	*	*	*	elevé/hty27-023/23 cage 9	*	*	Elevé/HTY27-023/23 Cage 9
8	*	*	*	*	*	*	*	*	*	*	elevé/hty27-023/23 cage 10	*	*	Elevé/HTY27-023/23 Cage 10
9	*	*	*	*	*	*	*	*	*	*	elevé/hty27-023/23 Cage 11	*	*	Elevé/HTY27-023/23 Cage 11
10	*	*	*	*	*	*	*	*	*	*	elevé/hwa96-045/22 cage 13	*	*	Elevé/HWA96-045/22 Cage 13
11	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-015/23 cage 11	*	*	Elevé/HTY27-015/23 Cage 11
12	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-045/22 cage 14	*	*	Elevé/HWA96-045/22 Cage 14
13	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-019/23 Cage 6	*	*	Elevé/HTY27-019/23 Cage 6
14	*	*	*	*	*	*	*	*	*	*	elevé/hty27-015/23 cage 11	*	*	Elevé/HTY27-015/23 Cage 11
15	*	*	*	*	*	*	*	*	*	*	elevé/hty27-015/23 cage 11	*	*	Elevé/HTY27-015/23 Cage 11
16	*	*	*	*	*	*	*	*	*	*	elevé/hty27-015/23 cage 11	*	*	Elevé/HTY27-015/23 Cage 11
17	*	*	*	*	*	*	*	*	*	*	elevé/hty27-038/22 Cage 10 X	*	*	Elevé/HTY27-038/22 Cage 10 X
18	*	*	*	*	*	*	*	*	*	*	elevé/hty27-038/22 cage 10	*	*	Elevé/HTY27-038/22 Cage 10
19	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-010/23 cage 5	*	*	Elevé/HTY27-010/23 Cage 5
20	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-034/21 cage 2	*	*	Elevé/HWA96-034/21 Cage 2
21	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-038/22 cage 10	*	*	Elevé/HTY27-038/22 Cage 10
22	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-010/21 cage 9	*	*	Elevé/HWA96-010/21 Cage 9
23	*	*	*	*	*	*	*	*	*	*	elevé/hwa96-010/21 Cage 9	*	*	Elevé/HWA96-010/21 Cage 9
24	*	*	*	*	*	*	*	*	*	*	elevé/hwa96-010/21 cage 9	*	*	Elevé/HWA96-010/21 Cage 9
25	*	*	*	*	*	*	*	*	*	*	elevé/hwa96-034/21 cage 2	*	*	Elevé/HWA96-034/21 Cage 2
26	*	*	*	*	*	*	*	*	*	*	elevé/hwa96-010/21 cage 9	*	*	Elevé/HWA96-010/21 Cage 9
27	*	*	*	*	*	*	*	*	*	*	elevé/hty27-019/23 cage 6	*	*	Elevé/HTY27-019/23 Cage 6
28	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-010/23 cage 5	*	*	Elevé/HTY27-010/23 Cage 5
29	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-02723 cage 14	*	*	Elevé/HWA96-02723 Cage 14
30	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-010/23 cage 5	*	*	Elevé/HTY27-010/23 Cage 5
31	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-010/21 cage 9	*	*	Elevé/HWA96-010/21 Cage 9
32	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-027/23 cage 14	*	*	Elevé/HWA96-027/23 Cage 14
33	*	*	*	*	*	*	*	*	*	*	elevé/Hwa96-027/23 cage 14	*	*	Elevé/HWA96-027/23 Cage 14
34	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-026/22 cage 1	*	*	Elevé/HTY27-026/22 Cage 1
35	*	*	*	*	*	*	*	*	*	*	elevé/Hty27-026/22 cage 1	*	*	Elevé/HTY27-026/22 Cage 1
36	*	*	*	*	*	*	*	*	*	*	elevé/hty27-026/22 cage 1	*	*	Elevé/HTY27-026/22 Cage 1
37	*	*	*	*	*	*	*	*	*	*	elevé/hty27-026/22 cage 1	*	*	Elevé/HTY27-026/22 Cage 1
38	*	*	*	*	*	*	*	*	*	*	elevé/hty27-020/23 cage 7	*	*	Elevé/HTY27-020/23 Cage 7
39	*	*	*	*	*	*	*	*	*	*	elevé/hty27-020/23 cage 7	*	*	Elevé/HTY27-020/23 Cage 7
40	*	*	*	*	*	*	*	*	*	*	elevé/hty27-020/23 cage 7	*	*	Elevé/HTY27-020/23 Cage 7
41	*	*	*	*	*	*	*	*	*	*	elevé/hty27-020/23 cage 7	*	*	Elevé/HTY27-020/23 Cage 7
42	*	*	*	*	*	*	*	*	*	*	elevé/hty27-037/22 cage 3	*	*	Elevé/HTY27-037/22 Cage 3
43	*	*	*	*	*	*	*	*	*	*	elevé/hty27-037/22 cage 3	*	*	Elevé/HTY27-037/22 Cage 3
44	*	*	*	*	*	*	*	*	*	*	elevé/hty27-037/22 cage 3	*	*	Elevé/HTY27-037/22 Cage 3
Parents

 

[igold]

It's late here on the East Coast of the US.
Tomorrow I will run the data out again and test all codes submitted and report accurate times....
I suspect as well that using the dictionary and not going to the worksheet for each loop will be much quicker.

 

[jolivanes]

@igold
Thank you very much. Appreciate it.

 

[harzer]

Hello igold, Jolivanes, Cubist.
Thank you for your interest in my request, it is very valuable.
I resumed my tests given Igold's remark and suggestion regarding Jolivanes' code.
I even went very far in my tests using 300.000 lines of data, here is the result of my tests:
1. The code that was very fast was that of Jolivanes, it was executed in 0.4844 seconds. It's very fast.
2. Cubiste's code ran in 1.0195 seconds. It's very fast too.
Thank you for your availability and sharing your knowledge.
Greetings to all three of you.

Here is the Jolivanes code :

Sub Or_So_Maybe()

    Dim StartTime As Double
    Dim SecondsElapsed As Double
    Dim ws As Worksheet

       'Remember time when macro starts
    StartTime = Timer
    Application.ScreenUpdating = False

    Dim dataArr, i As Long
    Set ws = Worksheets("Parents")
    dataArr = ws.Range("K1:K" & ws.Cells(ws.Rows.Count, 11).End(xlUp).Row).Value
        For i = LBound(dataArr) + 1 To UBound(dataArr)
            dataArr(i, 1) = Replace(Replace(Replace(Replace(Replace(Replace(dataArr(i, 1), "elevé", "Elevé"), "Hty27", "HTY27"), "hty27", "HTY27"), "Hwa96", "HWA96"), "hwa96", "HWA96"), "cage", "Cage")
        Next i
    ws.Cells(1, 11).Resize(UBound(dataArr)).Value = dataArr


        'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 4)

        'Notify user in seconds
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

 

[harzer]

Hello everyone,
Just a small correction, for my tests, my number of lines is 30.000 lines instead of 300.000 lines.
Greetings.

 

[jolivanes]

Thank you for doing the speed test and the update.
Now we'll have to wait for someone to better the time.

 

[igold]

This is what I have come up with. Tests were run using 155,757 lines of data. I used all posted codes and I wrote one myself that is a Hybrid of others here. It is posted at the end...

Name	Speed in Seconds
harzer	4.485
jolivanes	0.500
cubist	1.2031
igold	0.7344

jolivanes wins this round. It is very interesting to see how many different codes can accomplish the same task. I will save my workbook for any future submissions so that everyone will be tested on the same exact data. My code is below:

Sub ReplaceCharacter()

    Dim StartTime As Double
    Dim SecondsElapsed As Double

   'Remember time when macro starts
    StartTime = Timer
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim arrReplace, spl, spl2, spl3, spl4, spl5
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("Parents")
    arrReplace = ws.Range("K2:K" & Cells(Rows.Count, 11).End(xlUp).Row)
    For i = LBound(arrReplace) To UBound(arrReplace)
        spl = Split(arrReplace(i, 1), "-")(0)
        spl2 = Split(spl, "/")
        spl3 = Split(arrReplace(i, 1), "-")(1)
        spl4 = Split(spl3, " ")(2)
        spl5 = Split(arrReplace(i, 1), " ")
        
        Select Case spl2(0)
            Case "elevé"
                spl2(0) = "Elevé"
            Case "Hty27", "hty27"
                spl2(0) = "HTY27"
            Case "Hwa96", "hwa96"
                spl2(0) = "HWA96"
            Case "cage"
                spl2(0) = "Cage"
        End Select
        Select Case spl2(1)
            Case "elevé*"
                spl2(1) = "Elevé"
            Case "Hty27", "hty27"
                spl2(1) = "HTY27"
            Case "Hwa96", "hwa96"
                spl2(1) = "HWA96"
            Case "cage"
                spl2(1) = "Cage"
        End Select
        Select Case spl5(1)
            Case "elevé*"
                spl5(1) = "Elevé"
            Case "Hty27", "hty27"
                spl5(1) = "HTY27"
            Case "Hwa96", "hwa96"
                spl5(1) = "HWA96"
            Case "cage"
                spl5(1) = "Cage"
        End Select
        If UBound(spl5) < 3 Then
            arrReplace(i, 1) = spl2(0) & "/" & spl2(1) & "-" & Split(spl3, " ")(0) & " " & spl5(1) & " " & spl5(2)
        Else
            arrReplace(i, 1) = spl2(0) & "/" & spl2(1) & "-" & Split(spl3, " ")(0) & " " & spl5(1) & " " & spl5(2) & " " & spl5(3)
        End If
    Next i
    
    ws.Cells(2, 11).Resize(UBound(arrReplace)).Value = arrReplace
    Application.ScreenUpdating = True
    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 4)

    'Notify user in seconds
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
    
End Sub

 

[jolivanes]

A proverbial case of "All Roads Lead To Rome".
Thanks for doing that.

 

[igold]

No problem, I enjoyed the exercise. What this reminds me of, is that many times I will see someone post a question and get multiple responses. Almost invariably the OP will give the solution to the code that has the fewest lines or the poster with the highest number of solutions or reactions. Hardly ever does the OP look at the speed of execution. Granted, most codes are only being run on a relatively few lines of data, so the times are in fractions of seconds difference (barely a blink of the eye), but it is food for thought.

This comment is in no way reflective of this thread, just an overall observation of what goes on here...

Have great day everyone.

 

[harzer]

Hello everyone,
Many thanks to Igold for his new code.
Jolivanes: You summed up the situation well, “All roads lead to Rome”.
Thank you all (Jolivanes, Igold & cubist) for your codes and we look forward to reading you on the next occasion.
Greetings.