Excel 2003 Macro to add text to front of data in cell

[Rocky Lane]

I have an extremely simple task to perform manually. But to change over
10,000 cells - not! Everybody knows Excel allows you to write simple VBA
macros to do things like this.

OK ... I'm a dummy ... I give up. I could have manually done the changes in
the time I've wasted trying to create a working macro solution.

I have a 47,000 + row spreadsheet with 2 columns (not column A & B). After
manually selecting the current cell location, I want to start the macro. In
text cells in the first column, I want to search down the column looking for
the letters RCA. Case is not important. If found, I want to pause the macro
to allow me to decide if what the macro has found is acceptable.
If it is, I want to press the "y" key to add 47- to the front of data in the
cell to the right (second column) of the found cell in the first column. For
example if the second column cell contained 4862, after pressing the "y" key,
the cell would contain 47-4862 and the current cell location would move left
to the first column to continue searching for RCA.
If it is not acceptable, I want to press the "n" key and have the macro
continue searching for RCA from the current cell location down the first
column.

Help!

Thanks.

 

[OssieMac]

Hi Rocky,

Try the following macro. You can either use the Y, N and Esc keys or your
mouse to select from the msgbox.

You indicated that you wanted to select the cell where you want to start so
the macro relies on you doing this before you start it.

The Cancel key is so you can stop at any time and resume later but you will
need to select the cell where you stopped it before you restart the macro.

If you select a cell that meets the find criteria as your first cell, it
will not process that cell until last because Find always finds the next
ocurrence and then loops around to the start again. You will get a changed
message when it gets back to the first cell actually found. (Not the cell you
selected to start from but the first one it finds). If you want it to start
at a particular cell then select the cell above it before starting the macro.
(It does not have to meet the find criteria).

Feel free to get back to me if you have a problem with it.

Sub Find_And_Modify()

Dim strStart As String
Dim bolStart As Boolean
Dim rngColumn As Range
Dim strTofind As String
Dim Response

With ActiveSheet
Set rngColumn = ActiveCell.EntireColumn
End With

strTofind = "RCA"

bolStart = False

Do While Response <> vbCancel
rngColumn.Find(What:=strTofind, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False) _
.Activate

If ActiveCell.Address = strStart Then
MsgBox "You are back to the first found cell" _
& Chr(13) & "processing will terminate"
Exit Sub
End If

If bolStart = False Then
strStart = ActiveCell.Address
bolStart = True
End If

Response = MsgBox("Select Yes to Modify adjacent column" _
& Chr(13) & "No to continue search" _
& Chr(13) & "Cancel to exit", vbYesNoCancel)

If Response = vbYes Then
ActiveCell.Offset(0, 1) = "47-" & ActiveCell.Offset(0, 1)
End If

Loop

End Sub

 

[OssieMac]

Hi again Rocky,

I just realized that if you use the Cancel to stop and then start the macro
again later it will not know where your original start position is. (It will
think it is where you re-started). If this is going to cause a problem then
let me know what the cell address of the original start position is and I can
hard code it in and the macro can test for it. You will probably know by the
row numbers that it has looped around to the start again anyway.

 

[Don]

Rocky,

Here's a simple code that will open up a couple of input boxes that let you
select which column you want to examine and what you want to search for.
However, this is case sensitive and I've played with it for some time and
can't get it to be case insensitive, but I'm sure someone will jump in with
that solution....

Option Explicit
Sub Macro4()

Dim LastRow As Integer
Dim i As Integer
Dim x As String
Dim Col As String

Col = InputBox("What Column Do You Wish To Start In?")
With ActiveSheet
LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
End With
x = InputBox("Search For:")
For i = 1 To LastRow

If Range(Col & i).Value = x Then
Range(Col & i).Select
If MsgBox("Is This One To Addend?", vbYesNo + vbInformation) = vbNo Then
Range(Col & i).Offset(0, 1) = ""
Else
Range(Col & i).Offset(0, 1) = "47-" & Range(Col & i)
End If
End If
Next

I'm also fairly new to this coding so there most likely is a much simpler
way.....but, HTH...

Don

 

[Ron Rosenfeld]

However, this is case sensitive and I've played with it for some time and
can't get it to be case insensitive,

Simple way to make the comparison case insensitive is to precede your macro
with

Option Compare Text


So the start of your macro would look like:

Option Compare Text
Option Explicit
Sub Macro4()

Dim LastRow As Integer
Dim i As Integer
Dim x As String
Dim Col As String
--ron

 

[Don]

Thanks Ron......That is simple....I learn something new everytime I read this
forumn. Hope this helps the original op out.

Don

 

[Don]

Again my thanks Ron....added your Option, tested the macro...works like a
champ.

Don

 

[Ron Rosenfeld]

Again my thanks Ron....added your Option, tested the macro...works like a
champ.

Don

You're welcome. Glad to help.
--ron

 

[Rocky Lane]

Thank you kindly Don for this code. I copied it into a new macro adding the
extra line Don suggested. When I start the macro, your rmessage box pops up
asking for the column to start in. When I enter D or d, a run-time error 6
occurs (overflow). When I select the debug button it opens up the macro
editor with the line starting with LastRow = highlighted.

I am not familiar enough with macros or the editor to understand what it is
trying to tell me or how to correct this error. I would certainly appreciate
any feedback you can give me on this.

Thanks.

Rocky

 

[Don]

Hi Rocky,

Let me try this again...I notice I didn't have End Sub on my orginal post
either. Here's the complete module, copy and paste this, from Option Compare
Text to End Sub, into a completely new module. It works for me in 2003....


Option Compare Text
Option Explicit
Sub Macro4()

Dim LastRow As Integer
Dim i As Integer
Dim x As String
Dim Col As String

Col = InputBox("What Column Do You Wish To Start In?")
With ActiveSheet
LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
End With
x = InputBox("Search For:")
For i = 1 To LastRow

If Range(Col & i).Value = x Then
Range(Col & i).Select
If MsgBox("Is This One To Addend?", vbYesNo + vbInformation) = vbNo Then
Range(Col & i).Offset(0, 1) = ""
Else
Range(Col & i).Offset(0, 1) = "47-" & Range(Col & i)
End If
End If
Next
End Sub



When done, the two Option statements should appear above the top line of the
macro and all the rest should be below that same line.

If it doesn't work this time, maybe someone can jump in and tell us
why.....HTH

Don

 

[Don]

Sort of an afterthought but might be applicable to your application....if the
search string that you enter is not the full content of a cell, this macro
won't pick it up. A step would have to be designed to test each cell for the
contents of the search string, i.e......if you entered "ABC" as a search
string and one or more of the cells had "ABC...and some other text or data"
this macro would pass it.

Don

 

[Rocky Lane]

Hi Don,

I did have the End Sub but just to be sure I deleted the entire macro and
created a new one copying the code you sent. Unfortunetly, I got the same
error. I looked at the formula and thought that maybe an extra space in the
formulamay be the problem so I deleted it but the debugger just put the space
back in and re-highlighted the formula line.

I hope you can find a solution to this error.

Thanks again.

Rocky

 

[Don]

Rocky,

Here's a little better code...this one picks up your search string if it's
anywhere in the cell.

Option Compare Text
Option Explicit

Sub FindReplace()

Dim c As Variant
Dim ret As Integer
Dim MyString As String
Dim ReplaceWith As String
Dim MyCol As String
Dim Rge As Range
Dim i As Integer
Dim LastRow As Integer

On Error Resume Next
i = 0
MyCol = InputBox("What Column Do You Want To Search?")
With ActiveSheet
LastRow = .Cells(.Rows.Count, MyCol).End(xlUp).Row
End With
MyString = InputBox("What String Do You Wish To Search For?")
ReplaceWith = InputBox("What String Do You Wish To Write?")

Set Rge = Range(MyCol & "1:" & MyCol & LastRow)
For Each c In Rge
ret = InStr(c, MyString)
i = i + 1
If (Not IsNull(ret)) And (ret > 0) Then
Range(MyCol & i).Select
If MsgBox("Is This One To Addend?", vbYesNo + vbInformation) = vbNo
Then
Range(MyCol & i).Offset(0, 1).Value = ""
Else
Range(MyCol & i).Offset(0, 1).Value = ReplaceWith & _
Range(MyCol & i).Value

End If
End If
Next c

End Sub

This one gives you three input boxes, Column selection, Search string
selection and Replacement entry.

Let me know if it works for you.

Don

 

[Don]

Rocky,

If you're still reading this thread, I think the problem has been resolved.
Dave Peterson pointed out an error in my Dim statements. It only creates an
error when you're dealing with many thousands of rows, that's why I wasn't
catching the error and you were. I only checked down to 7000 rows. But his
fix appears to have fixed the macro so that it will work for you. Below is
the revised code:

Option Compare Text
Option Explicit

Sub FindReplace()

Dim c As Range
Dim MySearchValue As String
Dim MyString As String
Dim ReplaceWith As String
Dim MyCol As String
Dim Rge As Range
Dim i As Long
Dim LastRow As Long

On Error Resume Next
i = 0
MyCol = InputBox("What Column Do You Want To Search?")
With ActiveSheet
LastRow = .Cells(.Rows.Count, MyCol).End(xlUp).Row
End With
MyString = InputBox("What String Do You Wish To Search For?")
ReplaceWith = InputBox("What String Do You Wish To Write?")

Set Rge = Range(MyCol & "1:" & MyCol & LastRow)
For Each c In Rge
MySearchValue = InStr(c, MyString)
i = i + 1
If (Not IsNull(MySearchValue)) And (MySearchValue > 0) Then
Range(MyCol & i).Select
If MsgBox("Is This One To Addend?", vbYesNo + vbInformation) = vbNo
_ Then
Range(MyCol & i).Offset(0, 1).Value = ""
Else
Range(MyCol & i).Offset(0, 1).Value = ReplaceWith & _
Range(MyCol & i)
End If
End If
Next c

End Sub

My thanks to Dave Peterson for steering me in the right direction on this,
and explaining what was happening.

Hope this works for you now....

Don

 

[Rocky Lane]

Sorry for the delay Don. IE has prevented me from responding to your posts.
Microsoft said to turn off Pop-Up Blocker. It was off but I turned it back on
and off again and now I can respond.

First off, your revised macro worked .... sort of. The problem is if I say
no to a selection, it clears the cell to the right of the search cell and
continues searching for the next cell with RCA in it. I need the macro to
just leave the cell alone if I choose no. If I choose yes, then add the 47-
to the front of the cell data. In other words some cells contain 47-#### and
I just want to leave those alone. Other cells contain just #### and I want to
prefix those with 47-.

Now, I copied your lastest code and ran it. It gives me a compile error for
the line "If MsgBox( ....".

Hope you know what to do to fix this little annoyance.

Thanks.

Rocky

 

[Don]

Rocky,

Glad to hear we got it working and I've taken out the step that changes the
adjacent cells that you don't wish to change. The other problem was, I
believe, a line break problem. I think I've fixed this also. Anyway give it
a try and let me know.

Option Compare Text
Option Explicit

Sub FindReplace()

Dim c As Range
Dim MySearchValue As String
Dim MyString As String
Dim ReplaceWith As String
Dim MyCol As String
Dim Rge As Range
Dim i As Long
Dim LastRow As Long

On Error Resume Next
i = 0
MyCol = InputBox("What Column Do You Want To Search?")
With ActiveSheet
LastRow = .Cells(.Rows.Count, MyCol).End(xlUp).Row
End With
MyString = InputBox("What String Do You Wish To Search For?")
ReplaceWith = InputBox("What String Do You Wish To Write?")

Set Rge = Range(MyCol & "1:" & MyCol & LastRow)
For Each c In Rge
MySearchValue = InStr(c, MyString)
i = i + 1
If (Not IsNull(MySearchValue)) And (MySearchValue > 0) Then
Range(MyCol & i).Select
If MsgBox("Is This One To Addend?", vbYesNo + vbInformation) _
= vbYes Then
Range(MyCol & i).Offset(0, 1).Value = ReplaceWith & _
Range(MyCol & i)
Else
End If
End If
Next c

End Sub


We got it by the horns now...

Don

 

[Rocky Lane]

Hi again Don,

I tried mainframe programming in the 70's where adding 2 numbers together
took 4 pages of Fortran, PL1 or Assembler to get it to work. Cobol really
wasn't much better. The last time I even thought about code (in the early
90's), someone was boasting about how Perl could do amazing things with just
4 to 10 lines of code.

This simple task is becoming a complex programming project. It shouldn't be
this difficult, which says a lot about VBA I guess. I was surprised the first
time I tried your macro and it opened up the code in a debug mode with the
offending line highlighted but no message saying what was wrong or why. I
thought programming tools would have advanced a lot further than this by
2008. Anyways ...

The good news ... everything worked fine, no errors in your macro.

The bad news ... when I select a cell to addend, it writes only 47-RCA
instead of prefixing 47- to the number in the cell. I'm guessing a tweak is
needed in the last Then statement and I'll leave it to you to have at it.

A nice feature I would like to have but not necessary is if I stop the macro
for some reason, it has to start from Row 1 instead of where I stopped. I
guess another InputBox is needed asking for what row to start in.

Thanks again.

Rocky

 

[Don]

Rocky,

I misread your orginal post that's why it wasn't add the cells
correctly...easy fix. I'm making this think a little more user friendly and
will post the completed code later today. Be patient, I'm learning too....lol

Don

 

[rgibbons]

Would there be away to make it search the cell with a wildcard for any
string and then replace that cell with the new string + existing..
So if had 11111 it would find and replace with 47-11111
?

 

[Don]

OK Rocky.....MSN let me back on finally....here's what I came up
with...Tested it some but would advise you to test and re-test it...use
copies of your WB just in case.

This new code should do what you requested, including some things that will
make it more OP friendly. It will also keep track of where you stopped. The
MsgBox's and InputBox's are pretty self-explanatory.

First: Create a new WS and name it "WrkSht" without the quotes.

Second: On this new WS:
In Cell A1 enter "1"
In Cell A2 enter "A"
In Cell A3 enter "ABC"
In Cell A4 enter "47-"

All of the above without the quotes.

Input the following code into a new Module:

Option Compare Text
Option Explicit

Sub FindReplace()

Dim c As Range
Dim MySearchValue As String
Dim MyString As String
Dim ReplaceWith As String
Dim MyCol As String
Dim Rge As Range
Dim i As Long
Dim LastRow, LstRowUsed As Long
Dim Response, RowDir, PrevEnt As String

On Error Resume Next
i = 0
PrevEnt = _
MsgBox("DO YOU WANT TO USE PREVIOUS COLUMN USED: COLUMN: " _
& Sheets("WrkSht").Range("A2"), vbYesNoCancel + vbInformation)
If PrevEnt = vbCancel Then Exit Sub
If PrevEnt = vbYes Then
MyCol = Sheets("WrkSht").Range("A2")
End If
If PrevEnt = vbNo Then _
MyCol = InputBox("WHAT COLUMN DO YOU WANT TO SEARCH IN?")
Sheets("WrkSht").Range("A2") = MyCol
If MyCol = "" Then
Exit Sub
End If
With ActiveSheet
LastRow = .Cells(.Rows.Count, MyCol).End(xlUp).Row
End With
PrevEnt = _
MsgBox("WOULD YOU LIKE TO USE THE PREVIOUS SEARCH STRING USED: " _
& Sheets("wrksht").Range("A3"), vbYesNoCancel)
If PrevEnt = vbCancel Then
Exit Sub
End If
If PrevEnt = vbNo Then
MyString = InputBox("WHAT SEARCHSTRING DO YOU WANT TO USE?")
Sheets("WrkSht").Range("A3") = MyString
If MyString = "" Then Exit Sub
Else
MyString = Sheets("WrkSht").Range("A3")
End If
PrevEnt = MsgBox _
("WOULD YOU LIKE TO USE THE PREVIOUS STRING AS THE ADD FACTOR: " _
& Sheets("wrksht").Range("A4"), vbYesNoCancel)
If PrevEnt = vbCancel Then
Exit Sub
End If
If PrevEnt = vbNo Then
ReplaceWith = InputBox("WHAT WOULD YOU LIKE TO ADD?")
Sheets("WrkSht").Range("A4") = ReplaceWith
If MyString = "" Then Exit Sub
Else
ReplaceWith = Sheets("WrkSht").Range("A4")
End If
RowDir = _
MsgBox("WOULD YOU LIKE TO START WHERE YOU LEFT OFF?", _
vbYesNoCancel + vbInformation)
If RowDir = vbCancel Then Exit Sub
If RowDir = vbNo Then
i = InputBox("WHICH ROW WOULD YOU LIKE TO START ON?")
Sheets("WrkSht").Range("A1") = i
If i > 0 Then
GoTo Cont
Exit Sub
End If
Else
i = Sheets("WrkSht").Range("A1")
End If
Cont:
Set Rge = Range(MyCol & i & ":" & MyCol & LastRow)
For Each c In Rge
MySearchValue = InStr(c, MyString)
If (Not IsNull(MySearchValue)) And (MySearchValue > 0) Then
Range(MyCol & i).Select
Response = MsgBox("Is This One To Addend?", vbYesNoCancel _
+ vbInformation)
If Response = vbYes Then GoTo Add

If Response = vbCancel Then
Exit Sub
End If
If Response = vbNo Then GoTo Rep
End If
Rep:
i = i + 1
Sheets("WrkSht").Range("A1") = i
Next c
Exit Sub
Add:
Range(MyCol & i).Offset(0, 1).Value = ReplaceWith & _
Range(MyCol & i).Offset(0, 1).Value
GoTo Rep

End Sub

Make sure you've selected the Sheet that has the data you want to search.
(didn't put this in code as I wasn't sure what the name of your sheet was)

This could probably get cleaned up a bit, but I think it'll do what you've
asked for.

Let me know......

Don