Msg Box on each Loop to Replace text

[Ricky Pang]

Hello Experts,
How do you replace each "Total" with the text that is located
immediately below one line below an empty space? And how do you add a
Message Box notification to either accept or override for each Replace
action?

[space]
Payroll
Contract Labour
Employee Benefits
[space]
Total
[space]
Utilities
Utilities - Electric
Utilities - Gas
[space]
Total

The result:
Msgbox "Total" will be replaced by "Payroll". Option to "OK" to accept,
"Cancel" to not do any replacing, "Override" to manually enter a new
text.

"Total" would become "Payroll"
"Total" would become "Utilities"


I've tried using the Replace function but I needed only code would work
as each Replace is different.

Thanks in advance,
Ricky

 

[Guest]

are only the header words and total in Column A - the other data in column B?

This assumes such is the case. Test on a copy of your workbook

Sub ReplaceTotal()
Dim s as String, cell as Range, rng as Range
set rng = range(cells(1,1),cells(rows.count,1).end(xlup))
for each cell in rng
if instr(1,cell,"total",vbTextcompare) then
cell.Value = s
else
s = cell.value
end if
next
end sub

If that isn't the case, how can we determine the header words - indented by
two spaces? No spaces? what?

 

[Ricky Pang]

Hi Tom,
Good to hear from you. The header words are also located in column A
and the data are in columns B and beyond. The header word is identified
by jumping up 2 empty spaces from "Total" and picking the first word
below. For example;

[space] --- 1st empty cell
Payroll ----- This is the replacement header word.
Contract Labour
Employee Benefits
[space] --- 2nd empty cell
Total ---- This is the original word and should be replaced with
Payroll.

When I've ran your code, the Total has been replaced with the contents
located within 2nd empty cell. How do you get Total to be replaced with
Payroll?

Thanks so much for your help.

Ricky

 

[Ricky Pang]

Tom,
Just to clarify, the header and all titles (subtitles) are all within
column A. The data figures are in column B and beyond.

Thanks,
Ricky

 

[Tom Ogilvy]

Sub ReplaceTotal()
Dim s as String, cell as Range, rng as Range
Dim i as Long
set rng = range(cells(1,1),cells(rows.count,1).end(xlup))
for each cell in rng
if instr(1,cell,"total",vbTextcompare) then
i = cell.row - 2
do until len(Trim(cells(i,1))) = 0
i = i - 1
loop
cell.Value = cells(i +1,1).Value
end if
next
end sub

 

[Ricky Pang]

That's amazing Tom. It works and it's just what I am looking for.
Thanks very much.

Is it possible to add a message popup box to indicate the what the
replacement word will be as the cursor jumps through each "Total" so I
could see how far along the page the code has progressed?

Popup Msgbox box with each "Total" found:
"Total" will be replaced by "Payroll".
Option "OK" to accept; or
Option "Cancel" to do no replacements at all; or
Option "Override" to enter a new word.

This would be useful when this spreadsheet is passed on to someone new
in the future.

Much much appreciated.

Ricky

 

[Tom Ogilvy]

Choices on a msgbox are limited. So the choices will be Yes, No, Cancel.

Sub ReplaceTotal()
Dim s As String, cell As Range, rng As Range
Dim i As Long, ans As Long, s1 As String
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
If InStr(1, cell, "total", vbTextCompare) Then
i = cell.Row - 2
Do Until Len(Trim(Cells(i, 1))) = 0
i = i - 1
Loop
cell.Select
s = "Total will be replaced by " & Cells(i + 1, 1).Value & vbNewLine _
& vbNewLine _
& "Yes: Continue" & vbNewLine _
& "No: Do Not Replace" & vbNewLine _
& "Cancel: Use a word I will provide"

ans = MsgBox(s, vbYesNoCancel, "Make a Choice")
Select Case ans
Case vbYes
cell.Value = Cells(i + 1, 1).Value
Case vbCancel
s1 = InputBox("Provide Word to Use?", _
"Enter Replacement", Cells(i + 1, 1).Value)
If Len(Trim(s1)) > 0 Then
cell.Value = s1
End If
End Select
End If
Next
End Sub

 

[Ricky Pang]

Tom, this code is incredible. The popup message box really helps me
know what titles are about to be changed. The override option is great.

1) This is for self improvement about VB. When I ran your code, it
searches for all titles with the word "Total" within column A. In
comparison, how would the line be different if I needed to match and
replace a non-case-sensitive "Total" only so it would bypass other
titles with additional words such as Total Operating Expenses?

2) Having finished replacing all titles named "Total", how do you
replace a range between 2 empty spaces based on another Title search
such as "Total Operating Expenses"?
[space] --- this is the 1st space, range starts here.
Non-Operating Legal
Non-Operating Repairs
Non-Operating Leasing
[space] --- this is the 2nd space, range ends here.
Total Operating Expenses --- First, search for this title.

search for "Total Operating Expenses".
jump up to the 2nd empty space, mark it as Range ends.
jump up to the 1st empty space, mark it as Range starts.
then change everything within the range to become "Operating Expense".
keep maintaining the useful popup msgbox.

3) For more title replacements in the future, is there a place in code
that I could type in a search word such as "Collection Loss" and replace
with "Bad Debt" (while mainting the useful popup msgbox)?

Your help is greatly appreciated.

Thanks again,
Ricky

 

[Tom Ogilvy]

Change
If InStr(1, cell, "total", vbTextCompare) Then
to

If lCase(cell.Value) = "total" then


Sub ReplaceOtherStrings()
Dim s As String, cell As Range, rng As Range
Dim i As Long, ans As Long, s1 As String
Dim ans1 as String, ans2 as String
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
ans1 = InputBox("Enter Search Term")
if len(trim(ans1)) = 0 then exit sub
ans1 = lcase(ans)
if instr(1,ans1,"total",vbTextCompare) = 1 then
ans2 = Trim(Mid(ans1,7,255))
if lcase(right(ans2,1)) = "s" then
ans2 = Left(ans2,Len(ans2)-1)
end if
Else
ans2 = Ans1
End if
For Each cell In rng
If Trim(cell) = ans1 Then
i = cell.Row - 2
Do Until Len(Trim(Cells(i, 1))) = 0
i = i - 1
Loop
cell.Select
s = "Total will be replaced by " & _
ans1 & vbNewLine _
& vbNewLine _
& "Yes: Continue" & vbNewLine _
& "No: Do Not Replace" & vbNewLine _
& "Cancel: Use a word I will provide"

ans = MsgBox(s, vbYesNoCancel, "Make a Choice")
Select Case ans
Case vbYes
Range(Cells(i + 1, 1),Cell.offset(-2,0)).Value = ans1
Case vbCancel
s1 = InputBox("Provide Word to Use?", _
"Enter Replacement", ans1)
If Len(Trim(s1)) > 0 Then
Range(Cells(i + 1, 1),Cell.offset(-2,0)).Value = s1
End If
End Select
End If
Next
End Sub


Sub ReplaceSpecifiedWordWithSpecifiedWord()
Dim s As String, cell As Range, rng As Range
Dim i As Long, ans As Long, s1 As String
Dim ans1 as Long, ans2 as Long
ans1 = InputBox("Enter Search term")
ans2 = InputBox("Enter Replacement term"
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
If lcase(cell.value) = lcase(ans1) Then
cell.Select
s = ans1 & " will be replaced by " & ans2 & vbNewLine _
& vbNewLine _
& "Yes: Continue" & vbNewLine _
& "No: Do Not Replace" & vbNewLine _
& "Cancel: Use a word I will provide"

ans = MsgBox(s, vbYesNoCancel, "Make a Choice")
Select Case ans
Case vbYes
cell.Value = ans2
Case vbCancel
s1 = InputBox("Provide Word to Use?", _
"Enter Replacement", Cells(i + 1, 1).Value)
If Len(Trim(s1)) > 0 Then
cell.Value = s1
End If
End Select
End If
Next
End Sub


code is untested, so you may need to do a little debugging.
--
Regards,
Tom Ogilvy

Tom, this code is incredible. The popup message box really helps me
know what titles are about to be changed. The override option is great.

1) This is for self improvement about VB. When I ran your code, it
searches for all titles with the word "Total" within column A. In
comparison, how would the line be different if I needed to match and
replace a non-case-sensitive "Total" only so it would bypass other
titles with additional words such as Total Operating Expenses?

2) Having finished replacing all titles named "Total", how do you
replace a range between 2 empty spaces based on another Title search
such as "Total Operating Expenses"?
[space] --- this is the 1st space, range starts here.
Non-Operating Legal
Non-Operating Repairs
Non-Operating Leasing
[space] --- this is the 2nd space, range ends here.
Total Operating Expenses --- First, search for this title.

search for "Total Operating Expenses".
jump up to the 2nd empty space, mark it as Range ends.
jump up to the 1st empty space, mark it as Range starts.
then change everything within the range to become "Operating Expense".
keep maintaining the useful popup msgbox.

3) For more title replacements in the future, is there a place in code
that I could type in a search word such as "Collection Loss" and replace
with "Bad Debt" (while mainting the useful popup msgbox)?

Your help is greatly appreciated.

Thanks again,
Ricky

 

[Ricky Pang]

Hi Tom,
As the titles are in Proper-case (not in lower-case), I took out the
lCase to make the line just {If (cell.Value) = "Total" Then} for an
exact match. How would you alter this so that it is not case-sensitive
and entering "total" would still be valid?

Really need your help with the other 2 codes:
Sub ReplaceOtherStrings()
I've tried matching the lower-case/upper-case exact word but it takes no
action. I'm unsure of the end result with what Trim ans2 does as I
don't need it to be case-sensitive and also what;
{If InStr(1, ans1, "Total", vbTextCompare) = 1 Then} does
because "Total" would have been completely replaced through the Sub
ReplaceTotal() code already.

I need to make replacements of titles that is listed between 2 empty
cells. The search is based on locating "Total Operating Expenses"
first. Directly above "Total Operating Expenses" is an empty cell. The
list of titles to be replaced would then be located directly above it.
The word to replace is based on an input box of InputBox("Enter
Replacement Term").

I think that's what the ReplaceOtherStrings() was meant to do but I
really need your help.

Sub ReplaceSpecifiedWordWithSpecifiedWord()
errors at the first line; ans1 = InputBox("Enter Search term") is
highlighted. We could come back to this later.


So far this following code works very nicely. The Sub
ReplaceOtherStrings() would then be an extension of this code.

Sub ReplaceTotal()
Dim s As String, cell As Range, rng As Range
Dim i As Long, ans As Long, s1 As String
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
If (cell.Value) = "Total" Then
i = cell.Row - 2
Do Until Len(Trim(Cells(i, 1))) = 0
i = i - 1
Loop
cell.Select
s = "[Total] will be replaced by >>> " & Cells(i + 1, 1).Value &
vbNewLine _
& vbNewLine _
& "Yes: Continue" & vbNewLine _
& "No: Do Not Replace" & vbNewLine _
& "Cancel: Override to Input Alternate Title"

ans = MsgBox(s, vbYesNoCancel, "Select an Option")
Select Case ans
Case vbYes
cell.Value = Cells(i + 1, 1).Value
Case vbCancel
s1 = InputBox("Enter Alternate Title to Replace?", _
"Enter Replacement", Cells(i + 1, 1).Value)
If Len(Trim(s1)) > 0 Then
cell.Value = s1
End If
End Select
End If
Next
End Sub


As always, I greatly appreciate your help.

Thanks in advance,
Ricky

 

[Ricky Pang]

Hi Tom,
Upon debugging Sub ReplaceSpecifiedWordWithSpecifiedWord, I've changed
the ans1 and ans2 to String and it worked... I'd really appreciate your
help if you can help me expand on this code a bit then this code would
be complete.

I'm trying to avoid the data entry into the search and replacement
inputboxes. Instead, could this code obtain the search and replace
items off a list that's stored in the same file where this code is
stored? When I open another file and call upon this code, the code
would loop through the items to search and replace.

Dim s As String, cell As Range, rng As Range
Dim ans1 As Long, ans2 As String, s1 As String, s2 As String, s3 As
String
Dim s4, s5, s6, s7 As String
Dim r1, r2, r3, r4, r5, r6, r7 As String

'Search Titles: Hoping to have the code read the items off of a list
rather than coding it inside this code.
s1 = "Search A"
s2 = "Search B"
s3 = "Search C"
s4 = "Search D"
s5 = "Search E"
s6 = "Search F"
s7 = "Search G"

'Replacement Titles: Hoping to have the code read the items off of a
list rather than coding it inside this code. This Replacement titles
would be listed side by side corresponding with the Search titles list.
r1 = "Replace A"
r2 = "Replace B"
r3 = "Replace C"
r4 = "Replace D"
r5 = "Replace E"
r6 = "Replace F"
r7 = "Replace G"

'The remainder of this code searches only s1 and replaces with only r1.
How do you make it loop to go through the rest of the items ie. s2, s3,
s4 etc. to replace with r2, r3, r4 etc.?

Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng

If LCase(cell.Value) = LCase(s1) Then
cell.Select
s = "[" & s1 & "]" & " Will Be Replaced By " & "[" & r1 & "]" &
vbNewLine _
& vbNewLine _
& "Yes: Continue" & vbNewLine _
& "No: Do Not Replace" & vbNewLine _
& "Cancel: Override to Input Alternate Title"

ans1 = MsgBox(s, vbYesNoCancel, "Select an Option")
Select Case ans1
Case vbYes
cell.Value = r1
Case vbCancel
ans2 = InputBox("Enter Alternate Title to Replace",
"Enter Replacement")
If Len(Trim(ans2)) > 0 Then
cell.Value = ans2
End If
End Select
End If
Next

End Sub


As always, thank-you so much.

Sincerely,
Ricky