I'm struggling a bit with CheckSpelling in Excel. I have a merged cell that I want to check, but only this cell. Here's what I'm doing.
ActiveSheet.Unprotect strSheetPassword
Application.DisplayAlerts = False
Set ma = Range("B21").MergeArea
ma.MergeCells = False
Union(Range("B1"), ma(1, 1)).CheckSpelling
ma.MergeCells = True
Application.DisplayAlerts = True
ActiveSheet.Protect strSheetPassword
It's checking the cell I want, but it's also checking the rest of the document. In reading other posts, I got the impression that checking a single cell causes CheckSpelling to check the entire document. This is why I put in the Union with the Range("B1") - B1 contains header text that doesn't have any misspellings and is normally locked, so that users can't change it. But, it is still checking the rest of the sheet! I've tried quite a few variations on this, but it still keeps checking the rest of the sheet.
CONCLUSION
I had been under the impression that it was possible to invoke the CheckSpelling form and have it only check certain cells. Apparently, this isn't true. Instead of building my own form, I should be able to get away with checking the whole sheet each time, although I really don't like that. Thanks for all the feedback!
For a single merged cell:
Sub spell_me()
Dim b As Boolean
b = Application.CheckSpelling(Word:=ActiveCell.Text)
MsgBox b & vbCrLf & ActiveCell.Address & vbCrLf & ActiveCell.Text
End Sub
EDIT#1:
To find the miscreant word, you could Split() the text into individual words and check each word.
If it is enough if the wrong part gets highlighted you can use this:
Sub SpellCheck()
Dim response As Boolean
Dim words As Variant
Dim wordCount As Long
Dim startAt As Long
words = Split(ActiveCell.Text, " ")
'set all of the text to automatic color
ActiveCell.Font.ColorIndex = xlAutomatic
For wordCount = LBound(words) To UBound(words)
response = Application.CheckSpelling(word:=words(wordCount))
If Not response Then
'find out where it is in the text and color the font red
startAt = InStr(ActiveCell.Text & " ", words(wordCount) & " ")
ActiveCell.Characters(Start:=startAt, Length:=Len(words(wordCount))).Font.Color = vbRed
End If
Next
End Sub
Related
I have a lot of large tables in automatically generated word documents and I want to delete columns that have no values in them. They will all have headers, so essentially I need to check the values of rows 2 to the end or just get the whole column in a string and check after the first chr(14) which I understand is the column marker.
Is this possible without looping through the cells, row by row, which appears to be slow, or selecting the column which seems to cause the screen to have issues and the UI freezes, sometimes crashing Word.
What you want to do is perfectly possible but can run into an issue. There is a difference in the number of cells in the selection range reported (and consequently the text to process) depending on whether you use
selection.cells
or
selection.range.cells
The former works as expected, the latter does not.
The code below deletes columns in the way in which you describe and also includes debug.print statements to demonstrate the problem.
I've tested the code on a 5x6 table. Your experience may differ.
Sub DeleteEmptyTableColumns(this_table As Word.Table)
Dim my_cells As Range
Dim my_column As Long
Dim my_text As String
Dim my_last_row As Long
' Assumes that the Table is uniform
my_last_row = this_table.Rows.Count
Application.ScreenUpdating = False
With this_table
For my_column = .Columns.Count To 1 Step -1
DoEvents
Set my_cells = .Range.Document.Range( _
Start:=.Cell(2, my_column).Range.Start, _
End:=.Cell(my_last_row, my_column).Range.End)
' We have to use selection to get the correct text
my_cells.Select
Debug.Print
' Wrong numbers and text
Debug.Print my_cells.Cells.Count
Debug.Print my_cells.Text
' Correct information
Debug.Print Selection.Cells.Count
Debug.Print Selection.Text
' Back to the wrong information
Debug.Print Selection.Range.Cells.Count
Debug.Print Selection.Range.Text
my_text = Selection.Text
' Add other replacments as required.
my_text = Replace(my_text, " ", vbNullString)
my_text = Replace(my_text, vbCrLf, vbNullString)
my_text = Replace(my_text, Chr$(13), vbNullString)
my_text = Replace(my_text, Chr$(7), vbNullString)
If Len(my_text) = 0 Then
this_table.Columns(my_column).Delete
End If
Next
End With
Application.ScreenUpdating = True
End Sub
I have some code written to build a list of worksheets in a string based on if the user selects a checkbox to include the sheet in the PDF report. See below:
If CheckBox1.Value = True Then
PDFsheets = "Sheet11"
End If
If CheckBox2.Value = True Then
If PDFsheets = "" Then
PDFsheets = "Sheet13"
Else
PDFsheets = PDFsheets & ",Sheet13"
End If
End If
If CheckBox3.Value = True Then
If PDFsheets = "" Then
PDFsheets = "Sheet2"
Else
PDFsheets = PDFsheets & ",Sheet2"
End If
End If
For example, when all 3 checkboxes are selected, MsgBox PDFsheets shows the result Sheet11, Sheet13, Sheet2
NOW, when I try to do a multiple sheet select I get Run-Time Error 9 - Subscript Out of Range. The different things I've tried include:
ThisWorkBook.Sheets(PDFsheets).Select
ThisWorkBook.Sheets(Array(PDFsheets)).Select
xPDF() = Split(PDFsheets, ",")
ThisWorkBook.Sheets(xPDF).Select
xPDF() = Split(PDFsheets, ",")
ThisWorkBook.Sheets(Array(xPDF)).Select
xPDF() = Split(PDFsheets, ",")
For i = 0 to Application.CountA(xPDF) - 1
Sheets(xPDF(i)).Select
next i
ALSO, for the sake of brevity I have tried all of the above examples with ActiveWorkbook instead of ThisWorkBook. PLUS, I've tried rewriting my string building part to reference the sheets names instead of numbers with all of the examples above. So instead of Sheet11, Sheet13, Sheet2 the result was "Sheet11", "Sheet13, "Sheet2" with the double quotes around the sheets.
I've look at other questions and code examples on here and elsewhere that show this same goal and I'm using the selection line exactly as they have had it and I'm getting the Subscript out of range error. (I've also verified everything is spelled correctly)
Additional Note if I try typing the string value directly in it works - ThisWorkBook.Sheets("Sheet11, Sheet13, Sheet2").Select - However, this doesn't allow me to keep it variable.
Your are building a comma separated string that you must convert into an array. You were very close:
Sub BuildAString()
Dim PDFsheets As String
Dim s As Worksheet
PDFsheets = "Sheet1,Sheet2,Sheet3"
ary = Split(PDFsheets, ",")
Sheets(ary).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\TestFolder\Book1.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
Note this makes 1 pdf file for all three sheets. You would use a loop if you wanted 3 separate files.Note that there are no spaces inPDFsheets because my worksheet names have no spaces.
I am creating a table in my spreadsheet that contains categories, questions and answers for a quiz.
The user is presented with a form, allowing them to navigate around the workbook easily, this also includes a textbox option, allowing them to search for a phrase if they are unsure what category the question/answer may fall into.
I have generated a vlook up to pull from the table of categories/questions and answers to the user on a different worksheet.
I have also generated a count, so I am able to identify how many times this work appears across the quiz table.
My problem is I am struggling to develop a loop so that if the key phrase is found 6 times for example, i want 6 questions and answers to be listed to the user. Currently it is only pulling the final time it is found.
My current code includes the following:
Private Sub CommandButton1_Click()
If Len(search_text) = 0 Then
MsgBox "Please enter a key word to search for!", vbCritical
End If
Dim wordCount As Integer
wordCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), "*" & search_text.Value & "*")
'Else: wordCount = WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), search_text.Value)
If wordCount = 0 Then
MsgBox "No match found"
Else
Sheet2.Range("a7").Value = WorksheetFunction.VLookup("*" & search_text.Value & "*", Sheet1.Range("A2:c600"), 3, False)
Sheet2.Range("b7") = wordCount
End If
End Sub
Any advice on implementing a loop and to allow the question/answer to be printed one after another would be very much appreciated.
I have read many other question pages about this and none seem to match what I am trying to do.
Many thanks in advance
I use a combination of Find and FindNext to search through a range of cells for the term entered in the search_text input field. I added comments to my code to better help you understand what exactly is going on.
I don't know exactly what you need to do with the results when you find them, for now I just display a message box showing the match. We can work on what to actually do with the results if you want to clarify in the comments what exactly you want.
This code assumes you have a worksheet named Results
Private Sub CommandButton1_Click()
Dim rngResult As Range
Dim strFirstAddress As String
Dim i As Long
If Len(search_text.Text) = 0 Then
MsgBox "Please enter a key word to search for!", _
vbCritical
'Stop code exeuction if no search
'term is entered
Exit Sub
End If
'Clear the previous results range
Sheets("Results").Range("A2:C600").ClearContents
'Set i to row 2 of the results worksheet
i = 2
'Look in range A2:C600 of Sheet1
With Sheet1.Range("A2:C600")
'Perform the initial find
Set rngResult = .Find(What:=search_text.Text, LookAt:=xlPart)
'Check to ensure that the term is found
If Not rngResult Is Nothing Then
'Grab the cell address of the first match
'This will help to avoid an infinite loop
strFirstAddress = rngResult.Address
'Continue Searching
Do
'Display the output to you
'MsgBox "Matched '" & search_text.Text & "' to " & rngResult.Value & " in cell " & rngResult.Address
'Put the result on the results page
Sheets("Results").Range("A" & i & ":C" & i).Value = Range("A" & rngResult.Row & ":C" & rngResult.Row).Value
i = i + 1
'Move on to the next result
Set rngResult = .FindNext(rngResult)
'Break out of the loop when we return to the starting point of the search
Loop While Not rngResult Is Nothing And rngResult.Address <> strFirstAddress
End If
End With
'Clean up variables
Set rngResult = Nothing
End Sub
I have a couple of tables and want to replace column 2 or column 5 (if it exists) with check boxes.
If there is an asterisk in the cell, I want the check box checked = True.
If there's no asterisk, the cell will only be a unchecked check box. These check boxes are from the developer tab, under controls, legacy forms.
I researched but failed:
replacing an asterisk with a check box (checked)
limiting it to a specific column (see image)
replacing a blank cell with a check box (unchecked)
limiting the action to a specific column (2 and 5 (if it exists))
Dim oCell As Cell
Dim oRow As Row
For Each oRow In Selection.Tables(1).Rows
For Each oCell In oRow.Cells 'this won't work specifically with my example, needs to be a little more specific
If oCell.Range.Text = "*" Then
MsgBox oCell.RowIndex & ", " & oCell.ColumnIndex & " check it!"
'I don't how to put in a check box here
End If
Next oCell
Next oRow
'I want to combine the top code and code below...right?
'do for each cell in column 2
With ActiveDocument.FormFields.Add(Range:=ActiveDocument.Selection, Type:=wdFieldFormCheckBox)
If cellvalue = "" Then 'just verbal logic here
.CheckBox.Value = False
End If
If cellvalue = "*" Then 'just verbal logic here
.checkbox.Value = True
End If
End With
Here's how I would do this:
Dim objDoc As Document
Dim oCell As Cell
Dim oCol As Column
Dim objTable As Table
Dim bFlag As Boolean
Set objDoc = ActiveDocument
Set objTable = Selection.Tables(1)
'This may or may not be necessary, but I think it's a good idea.
'Tables with spans can not be accessed via the spanned object.
'Helper function below.
If IsColumnAccessible(objTable, 2) Then
For Each oCell In objTable.Columns(2).Cells
'This is the easiest way to check for an asterisk,
'but it assumes you have decent control over your
'content. This checks for an asterisk anywhere in the
'cell. If you need to be more specific, keep in mind
'that the cell will contain a paragraph return as well,
'at a minimum.
bFlag = (InStr(oCell.Range.Text, "*") > 0)
'Delete the content of the cell; again, this assumes
'the only options are blank or asterisk.
oCell.Range.Delete
objDoc.FormFields.Add Range:=oCell.Range, Type:=wdFieldFormCheckBox
'Set the value. I found some weird results doing this
'any other way (such as setting the form field to a variable).
'This worked, though.
If bFlag Then
oCell.Range.FormFields(1).CheckBox.Value = True
End If
Next oCell
End If
'Then do the same for column 5.
Public Function IsColumnAccessible(ByRef objTable As Table, iColumn As Integer) As Boolean
Dim objCol As Column
'This is a little helper function that returns false if
'the column can't be accessed. If you know you won't have
'any spans, you can probably skip this.
On Error GoTo IsNotAccessible
IsColumnAccessible = True
Set objCol = objTable.Columns(iColumn)
Exit Function
IsNotAccessible:
IsColumnAccessible = False
End Function
I'm at a loss when trying to figure out where this code is tripping up. I am looking to rename the activesheet by using a concat of two ranges on the activesheet and some static text. When only one worksheet is in the workbook, the code works great. As soon as a second worksheet is added, I get a Runtime Error 1004. I'll highlight the line of code where it is breaking. This code currently resides in a normal module.
Option Explicit
Sub updateName()
Dim fNumber
Dim pCheckNumber
Dim asName As String
Dim tempASName As String
Dim worksheetName As Object
If ActiveSheet.Name = "Launch Page" Then Exit Sub
fNumber = ActiveSheet.Range("FlightNumber").Value
pCheckNumber = ActiveSheet.Range("PerformanceCheckNumber").Value
If fNumber <> "" And pCheckNumber <> "" Then
tempASName = "Flight " & fNumber & " | Run " & pCheckNumber & " (0.0%)"
asName = tempASName
MsgBox ActiveSheet.Name & vbCr & asName
ActiveSheet.Name = asName
worksheetName.Caption = asName
Else
Exit Sub
End If
End Sub
I'm in the process of adding error checking to ensure that I don't have duplicate sheet names. However, due to the nature of the field names, this will never occur.
I appreciate all of the insights!
The error you are reporting is, most likely, provoked because of trying to rename a Worksheet by using a name already in use. Here you have a small code to avoid this kind of situations:
Dim newName As String: newName = "sheet1"
Dim addition As String: addition = "_2"
Do While (Not sheetNameFree(newName))
newName = newName & addition
Loop
Where sheetNameFree is defined by:
Function sheetNameFree(curName As String) As Boolean
sheetNameFree = True
For Each Sheet In ActiveWorkbook.Sheets
If (LCase(Sheet.Name) = LCase(curName)) Then
sheetNameFree = False
Exit Function
End If
Next Sheet
End Function
You can adapt this code to your specific needs (for example, by converting addition into a number which grows after each wrong name).
In your code I see one other problem (although it shouldn't be triggering a 1004 error): you are accessing the property Caption from an non-instantiated object (worksheetName), whose exact functionality is not too clear. Just delete this line.
NOTE: good point from KazJaw, you might be using an illegal character. If fNumber and pCheckNumber are numbers or letters, it would be OK.
NOTE2: if with worksheetName you want to refer to an ActiveX Label in your workSheet, better do: ActiveSheet.Label1.Caption (where Label1 is the name of the Label). You cannot define worksheetName as a Label, because it is not a "conventional Label".