Need your help. And I know in advance that the built-in "CTRL + H" function is supposed to give an appropriate answer - but in my case it is not. Because of text language issues, and because I have a lot of characters that are not "letters or numbers" - the usual search and swap causes mistakes.
And now for the request - and many many thanks in advance!
I was able to "scrape" and revamp a relatively simple code, which performs a search and replacement of the entire document, to which I was able to thread MSGBOX for requests confirmation for each replacement:
"OK" button - confirms a single replacement.
"No" button - skips this search - and does not make a switch.
"Cancel" button - stops the macro.
How do you add a fourth button that will perform "Replace All"?
Is there a "count-down" option for running without user intervention? I want the default to be "Ok", and even if I did not press, then after 3 seconds - a change will be made.
I've been breaking my head for many days - and can not convert this code that will only work in selected / marked text.
HERE IS THE CODE I USE
Sub Want2Replace()
Dim myRange As Range
Set myRange = ActiveDocument.Content
myRange.Find.ClearFormatting
myRange.Find.MatchWildcards = True
Dim cached As Long
cached = myRange.End
Do While myRange.Find.Execute("åÀ")
myRange.Select
MyAnswer = MsgBox("Replace " & myRange.Find.Text & "?", vbYesNoCancel)
If MyAnswer = vbYes Then Call Shva_Na
If MyAnswer = vbCancel Then Exit Sub
myRange.Start = myRange.Start + Len(myRange.Find.Text)
myRange.End = cached
Loop
End Sub
Depending on your requirements, you can write a second function with ReplaceAll or adapt your function according to user expectations.
You can also add another MsgBox that asks for ReplaceAll.
So you have to decide and answer yourself the question whether the user actually wants ReplaceAll and/or a single Replace is a special function as an additional function.
Related
Would appreciate some help with this problem.
I need to find all occurrences of a string in a Word document. When the string is found some complicated editing is performed on it. Sometimes no editing is needed and the string is left untouched. When all that is taken care of, I continue looking for the next occurrence of the string. Until the end of the document.
I wrote a routine to do that :
It starts by defining a Range (myRange) that covers the whole document.
Then a Find.Execute is performed.
When an occurrence is found I do the editing work.
Meanwhile myRange has been automatically redefined to cover only the found region (this is well documented in the VBA WORD documentation > FIND Object).
Then I redefine myRange to cover the portion of the text from the end of the previous found region down to the end of the text.
I iterate this until the end of the document.
This routine works well EXCEPT when an occurrence of the string is found in a TABLE. Then it is impossible to redefine myRange to cover the region from the end of the previous found down to the end of the text. In the redefinition VBA insists on including the previous found region (actually the whole TABLE). So when I iterate it keeps finding the same occurrence again and again and looping for ever.
What follows is a simplified version of my routine. It does nothing it is just to illustrate the problem. If you run it on a document where the string "abc" appears you will see it running happily to completion. But if your document has an occurrence of "abc" in a TABLE the routine loops for ever.
Sub moreTests()
Dim myRange As Range
Dim lastCharPos As Integer
Set myRange = ActiveDocument.Range
lastCharPos = myRange.End
myRange.Find.ClearFormatting
With myRange.Find
.Text = "abc"
End With
While myRange.Find.Execute = True
'An occurrence of "abc" has been found
MsgBox (myRange.Text)
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
'myRange has been redefined to encompass only the found region (the "abc" string)
'Perform whatever editing work is needed on the string myRange.Text ("abc")
'Now redefine myRange to cover the remainder of the document
myRange.Start = myRange.End
myRange.End = lastCharPos
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
Wend
End Sub 'moreTests
I have several ways in mind to circumvent this problem. But none of them is simple, let alone 'elegant'. Does someone know if there is a 'standard' / 'proven' way of avoiding this problem ?
Many many thanks in advance.
I have a large, dynamic Word macro with lots of formfields on it. It takes a long time to run, and by far the most time consuming part is clearing all the formfields before mapping them. Right now I'm looping through them and setting them individually = "". I found a quicker way to do it, but it always corrupts the document.
1) Current:
For Each fld In doc.FormFields
If fld.Type = wdFieldFormTextInput And fld.Result <> "" Then
fld.Result = ""
ElseIf fld.Type = wdFieldFormCheckBox Then
fld.CheckBox.Value = False
End If
Next
2) Tried:
ActiveDocument.ResetFormFields
and 3)
Unload Me
in a command button click event
1) Takes at least a minute every time
2) is almost instant but corrupts the document (error saying "Word has encountered a problem. You will not be able to undo this action...")
3) Throws an error- "361: Can't load or unload this object"
I either want 2) to work, or to find any faster way to clear the formfields.
Thanks for your time.
Referring to (2): this is not so much an error message as a warning, and there's no document corruption. Word always loses the Undo list when a document is unprotected, which is what happens behind the scenes with this method.
Two approaches occur to me. One would be to disable alerts, which should suppress the warning. The other would be to emulate the user action of unprotecting, then re-protecting without saving the current form field entries.
To suppress the warning (this won't affect true error messages):
Application.DisplayAlerts = wdAlertsNone
To unprotect then reprotect the document without saving user input:
Sub UnprotectReprotectToResetFields()
Dim doc As Word.Document
Set doc = ActiveDocument
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
doc.Protect wdAllowOnlyFormFields, False
End Sub
I will try to be as clear as possible in the description, so here goes nothing:
I have created a code in which the user selects his excel file and then the macro copies the Sheet from that file into my macro Workbook.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
ActiveSheet.Copy After:=wbook.Sheets(1)
ActiveSheet.Name = "Selected file"
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
This is working, but what I realized is, that there might be cases where the selected file has multiple Sheets.
Is there a way to write the macro in which if my selected file has 1 sheet it runs the above code and if it has more than one sheet to let me select the sheet I want and then run the rest of the code?
Edit:
I thought of another way to handle this — perhaps closer to what you were looking for . . .
It's just an expansion of the basic pause routine that I use occasionally.
This is my "regular" Pause routine (using the Timer function):
Sub Pause(seconds As Single)
Dim startTime As Single
startTime = Timer 'get current timer count
Do
DoEvents 'let Windows "catch up"
Loop Until Timer > startTime + seconds 'repeat until time's up
End Sub
...so, it gave me an idea.
Honestly, I was a little surprised to discover that this works, since it's basically running two sections of code simultaneously.
Code for WaitForUserActivity :
Here's the code I used in the demo above:
Option Explicit
Public isPaused As Boolean
Sub WaitForUserActivity() 'THE 'RUN DEMO' BUTTON runs this sub.
Dim origSheet As String
isPaused = True 'flag "pause mode" as "on"
origSheet = ActiveSheet.Name 'remember current worksheet name
MsgBox "This will 'pause' code execution until you" & vbLf & _
"click the 'Continue' button, or select a different a worksheet."
Application.StatusBar = "PAUSED: Click ""Continue"", or select a worksheet."
Do 'wait for button click or ws change
DoEvents 'yield execution so that the OS can process other events
Loop Until (Not isPaused) Or (ActiveSheet.Name <> origSheet)
If isPaused Then 'the active worksheet was changed
MsgBox "Worksheet '" & ActiveSheet.Name & "' was selected." _
& vbLf & vbLf & "Now the program can continue..."
Else 'the button was clicked
MsgBox "The 'Continue' button was clicked." _
& vbLf & vbLf & "Now the program can continue..."
End If
Application.StatusBar = "Ready"
End Sub
Sub btnContinue() 'THE 'CONTINUE' BUTTON runs this sub.
isPaused = False 'flag "pause mode" as "off"
End Sub
To run the demo:
place the above code in a regular module
make sure the workbook has at least two worksheets
create two command buttons:
one for the "Run Demo" button, assign macro: WaitForUserActivity
one for the "Continue" button, assign macro: btnContinue
click the "Run Demo" button
The key command in the code is the DoEvents Function, which "yields execution so that the operating system can process other events."
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component - and the operating system takes care of multitasking and time slicing.
Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Further details (and warnings) at the source.
Original Answer:
Some suggested solutions:
Instead of "stopping" the code you could prompt the user to specify which worksheet.
The easiest way would be with an InputBox where the user would enter an ID number or otherwise identify the worksheet.
More complicated but more robust and professional-looking would be a custom dialog box with the help of a userform. There are several examples and tutorials online such as this one.
You could "pause" execution to give the user a set amount of time to select a worksheet, with a simple timer loop, ad you could even check the worksheet name to see if the user picked a new one, something like this:
Dim startTime As Single, shtName As String
If ThisWorkbook.Worksheets.Count = 1 Then
MsgBox "There is only one worksheet in this workbook."
Else
shtName = ActiveSheet.Name 'get name of active sheet
MsgBox "You have 5 seconds to select a worksheet after clicking OK.", _
vbOKOnly + vbInformation, "Select a worksheet... fast!"
startTime = Timer
Do
DoEvents
Loop Until Timer > startTime + 5
'check if user picked a new worksheet
If ActiveSheet.Name = shtName Then
MsgBox "You didn't select a new worksheet!"
Else
MsgBox "Thanks for selecting a new worksheet!"
End If
End If
It's a little hoakey but could work, especially if proper checks to make sure you've got the correct worksheet now.
I suppose you could create an worksheet event procedure that would run when a worksheet is activated, and checked a global variable to see if your "import procedure" was running, and if so, resume your code... but that would be messy and confusing and would require the code to exist in the workbook you're "importing".
Or, better than any of those would be to programmatically/logically determine which worksheet you need based on the contents of the worksheet. Is there a title? A certain date? Maybe the newest worksheet? Something in a certain cell? There must be something that differentiates it from the others.
Hopefully this gives you some ideas towards a non-linear solution. 😉
As in whole, I would recommend ashleedawg's solution, but if you
insisted on maintaining your code structure, your code could look
something like this:
You can distinguish between amount of Sheets a Workbook has using .Count property of the Sheets object (or Worksheets if you do not want to include Charts) and use InputBox to check for the sheet you want to look for.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
If ThisWorkbook.Sheets.Count = 1 Then
ThisWorkbook.ActiveSheet.Copy After:=wbook.Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Selected File"
Else
Dim checkfor As String
checkfor = InputBox("What Sheet should I execute the code for?")
Dim i As Integer
For i = 0 To ThisWorkbook.Sheets.Count
If Trim(LCase(checkfor)) = Trim(LCase(Sheets(i).Name))) Then
ThisWorkbook.Sheets(i).Copy After := wbook.Sheets(1)
ThisWorkbook.Sheets(i).Name = "Selected file"
End If
Next i
End If
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
Might need some further tweaking, because I was unsure what exactly you wanted to achieve.
I have solid experience in C++ but am still getting used to the syntax of VBA and I think that's what's tripping me up in my code.
What I'm trying to do is have a button that asks the user for a name. If the name entered is in column B, then tell the user the name was found and select where it is (no problem with this). If the name is not found, then ask if the user wants to try another name (no problem with this, either).
Where I'm having trouble is with the "Cancel" buttons. At any time, I want the user to be able to hit "Cancel" and immediately stop the loop, but stay in the sub because I'll be adding to this later.
Here's the code:
Dim inputName As String
Dim row As Integer
Dim i As Integer
Dim tryAgainResponse As Integer
tryAgainResponse = vbOK
'Ask user for name they would like to replace'
inputName = InputBox("What is the name of the person you would like to find? (First Last)")
'Find the row that the name is located and tell the user where it is'
Do While tryAgainResponse = vbOK
For i = 1 To 1000
If Cells(i, 2).Value = inputName Then
MsgBox ("Found the name! It's located at cell B" & i & ".")
ActiveSheet.Cells(i, 2).Select
tryAgainResponse = 0
Exit Do
End If
Next i
tryAgainResponse = MsgBox("We didn't find the name you were looking for. Please try again.", vbOKCancel)
If tryAgainResponse = vbCancel Then
Exit Do
End If
inputName = InputBox("What is the name of the person you would like to find? (First Last)")
Loop
I've tried plenty of things, but the main error is when you hit cancel for the first MsgBox, it tells you the name was found in the first blank square.
Any help or suggestions would be greatly appreciated! This is my first VBA program, so it's not the prettiest, but it's definitely a lot of fun. Thanks!
I'm not sure if I'm understanding what you're asking for, and I can't comment for clarification, but I think your hang up is that when you click cancel on the INPUT box, your input box is returning a blank string, and the rest of your code is then finding a blank cell.
Use the Application.Input Method, declare your input string as a variant, and test if it is false. If it is, use an Exit Sub to exit the macro. You could also test if your input string = "" and then exit the macro if true with the code you have.
From MrExcel
There are 2 versions of InputBox in VBA.
The InputBox Function is called without an object qualifiier and returns the contents of the text box or a zero-length string ("") if the user clicks Cancel.
The InputBox Method is a member of the Application object, so it is called by using Application.InputBox. It returns the contents of the text box or False if the user clicks Cancel. It is more versatile than the InputBox Function because it has a Type argument which specifies the return data type.
The function InputBox() will return an empty string if cancelled. The empty string will compare equal to the first cell that is empty.
Here's the doc of the function: http://msdn.microsoft.com/en-us/library/6z0ak68w(v=vs.90).aspx
Disclaimer: It's been a few years since I worked (a lot) with VBA, so this might be an issue caused by confusing myself with what is essentially a very different language from what I usually deal with.
So; I've got a workbook (Excel 2010) with multiple sheets (20+), most of whom are multi-page. To make things easier when printing everything, I want to add some sheet-specific headers with amongst others the name of the sheet, number of pages and so on.
I've written a tiny function that should (in theory) do this for me by iterating over all the sheets setting the header. However, for some reason it only works if the header is empty; if it already has a value it refuses to overwrite for some unknown reason.
Dim sheetIndex, numsheets As Integer
sheetIndex = 1
numsheets = Sheets.Count
' Loop through each sheet, but don't set any of them to active
While sheetIndex <= numsheets
Dim sheetname, role, labeltext As String
sheetname = Sheets(sheetIndex).name
role = GetRole(mode)
labeltext = "Some text - " & sheetname & " - " & role
With Sheets(sheetIndex).PageSetup
.LeftHeader = labeltext
.CenterHeader = ""
.RightHeader = "Page &[Page] / &[Pages]"
.LeftFooter = "&[Date] - &[Time]"
.CenterFooter = ""
.RightFooter = "Page &P / &N"
End With
sheetIndex = sheetIndex + 1
Wend
I found a solution that seems to work for replacing text. For whatever reason, in the macro, you need to include the header/footer format character codes in order for it to work properly.
This code worked to replace existing header text with new information:
Sub test()
Dim sht As Worksheet
Set sht = Worksheets(1)
sht.PageSetup.LeftHeader = "&L left text"
sht.PageSetup.CenterHeader = "&C center Text"
sht.PageSetup.RightHeader = "&R right text"
End Sub
Without the &L, &C, and &R codes before the text, I could not get it to work.
Some interesting behavior I found is that if you use the following code:
.CenterHeader = "&L some text"
it will actually put the some text in the LeftHeader position. This led me to believe that the formatting codes were very important.
The line Application.PrintCommunication = False (which is added by the macro recorder) before doing PageSetup screws up the formating via VBA.
If your code has got this line in it, try removing it. That solved my problem with setting the header and footer via VBA.
I've read StackOverflow for years and this is the first time I've actually been able to post a solution ... hope it helps someone!! Also, you need to remember, I am a CPA not a programmer ;-)
I am reading some values from the ActiveSheet to populate the header. The application is a tax election that will be sent with a tax return so it must have the taxpayer's name and social security number at the top.
Sub PrintElection()
' Print preview the MTM Election
If Range("Tax_Year").Value = Range("First_MTM_year").Value Then
ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Election").Range("Taxpayer_Name").Value)
ActiveSheet.PageSetup.RightHeader = Format(Worksheets("Election").Range("Taxpayer_SSN").Value)
ActiveWindow.SelectedSheets.PrintPreview
Else
MsgBox "The 'Effective For Tax Year' date must EQUAL the 'First MTM year' date", vbOKOnly, "Check Years"
Sheets("Roadmap").Select
Range("First_MTM_year").Select
End If
End Sub
It checks to see if the Mark-to-Market election year is the same as the election form then formats the election page.
I split the sheet print setup into 2 loops. First loop with Application.PrintCommunication = False I run the non-header/footer setup. I then set Application.PrintCommunication = True and run the header/footer setup in a second loop. Appears to run faster than in XL2003, and applies the header/footer correctly. Until MS fixes this bug, that works fine for me.