Excel VB Macro help...

Atari911

n00b
Joined
Aug 28, 2009
Messages
27
I have a macro written in VB that works but not "perfectly".
Basically it looks at a range of cells and replaces X text with Y text. Very simple.
The problem that I have is I would like for it to replace the text with a literal match.
For example:
Replacing "B" with "BOMB" on a row that has "BOMB" on it would result is "BOMBOMBOMB"

What happens is it takes every "B" and replaces it with "BOMB".
What I would like it to do is to replace cells that have literally only "B" in them with "BOMB".
If a cell has anything else than just "B" it is ignored.

Here is the code:
Code:
Sub Replace_ALL()
Dim lr As Long, c As Integer, r As Integer
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

lr = Cells(Rows.Count, "A").End(xlUp).Row

For r = 1 To lr 'cycle rows
    For c = 1 To 1 'columns A to A
        Cells(r, c).Value = replace(Cells(r, c).Value, "B", "BOMB")
     Next c
Next r

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With
End Sub
 
Here's a quick and dirty solution, just test for the length of the cell before substitution:

Code:
Sub Replace_ALL()

    Dim lr As Long, c As Integer, r As Integer
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    For r = 1 To lr 'cycle rows
        For c = 1 To 1 'columns A to A
            If Len(Cells(r, c).Value) = 1 Then
                Cells(r, c).Value = Replace(Cells(r, c).Value, "B", "BOMB")
            End If
         Next c
    Next r
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub
 
That looks like it would do the trick! I am going to test it out shortly and ill let you know if it worked.
Thank you!!!
 
Back
Top