VBA Loop to replace first part of formula with a Letter

[azhun_ctech]

Hi All,

Please forgive me as I am still new to VBA and haven't quite figured out everything. I have a set of values (all in column A) that start with "7971" and I want to replace those characters with an "A" (IE: 797100910885 becomes A00910885") in the same column, if possible. If it goes to column B then that is ok as well. I want a formula to be able to loop through all of the values in column A and apply this change.

I was able to do it for one cell using the following code:

Sub macro3()

'Macro3 Macro




  Dim originaltext As String, correctedtext As String
    
   originaltext = Range("a2").Value
   correctedtext = replace(originaltext, "7971", "A")
    
    Range("a2").Value = correctedtext
    
End Sub 

[End of code]

I have tried a few different approaches but am unable to make it so that it loops succesfully. I have tried the following code and get a mismatch type error and I'm not sure why. 

[code]

Sub replacement()
    Dim cell As Range, correctedText As String, originalText As String
    
    
    'loops through each cell in column A
    For Each cell In ActiveSheet.Range("A1:A50000")
     correctedText = replace(originalText, "7971", "A")
    Next cell
    
    
    
    Dim ws As Worksheet
    Dim LR As Long
    Set ws = Application.ActiveSheet
    
    LR = ws.Range("A:A" And ws.Rows.Count).End(xlUp).Row
    ws.Range("A:A" & LR).Formula = replace(Range("A:A").Value, "7971", "A")
      
      
End Sub

[end of code]

What am I missing here? I have tried defining originalText and it doesn't seem to pull it as desired. I am sure it's a fairly simple fix but I've not had any luck so far! 

Thanks in advanced for your help! 

Ctech

 

[azhun_ctech]

Also, if I could get it so that it would stop when the original cell is empty that would be great!

Thanks again!

 

[Joe4]

Welcome to the Board!

A few things:
- Looping through that many cells could really slow the loop down. Don't loop through more any rows you than you need to but finding the last row with data in column A.
- The danger in using "Replace" is that it will also replace that string if it finds it anywhere (including the middle) of your string. If you really only want to look at the beginning of the string, use LEFT instead.

Try this:

Sub MyMacro()

    Dim lrow As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lrow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows
    For r = 1 To lrow
        If Left(Cells(r, "A"), 4) = "7971" Then
            Cells(r, "A") = "A" & Mid(Cells(r, "A"), 5)
        End If
    Next r
    
    Application.ScreenUpdating = True

End Sub

 

[azhun_ctech]

Hi Joe4,

Thanks for your advice, that is actually exactly what I was hoping to not do (slow the loop down, and replace that string anywhere it is found) so I appreciate your help and advice!

The code worked fantastic!

Thank you so much for all of your help!

Ctech

 

[Joe4]

You are welcome!
Glad I was able to help.

Also, when working with things things like loops, it often speeds up the code to suppress screenupdating until the code finishes (that is those other lines you see in there).

 

[azhun_ctech]

Ok, is that what causes the screen to blip a bit when running the macro? Or it also looks like the program has frozen as it runs the macro?

 

[Joe4]

Yes, the "blipping" is all the intermediate screen updates, which slow things down. You can wait and just update once at the end, and speed things up (like I did in the code).

 

[azhun_ctech]

Perfect. That's good to know for some of my other macros, I wondered if there was a way to hide it and now I know!

Thanks again!

 

[DanteAmor]

How about the following without loop

Sub replace_first_part()
  Application.ScreenUpdating = False
  On Error GoTo comingout
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate(Replace("IF(left(@,4)=""7971"",""A""&mid(@,5,len(@)),@)", "@", .Address))
  End With
comingout:
  Application.ScreenUpdating = True
End Sub