Writing a macro I found out that I need to skip the table contents and place my cursor right after that, for this I am using a code as
Selection.Tables(cnt).Select
Selection.Collapse WdCollapseDirection.wdCollapseEnd
Here, cnt is a counter value which increases each time a table is found, but if run the macro in selective pages then how will i know the number of nth table inside which my cursor is.
Important! This solution allows you to find the number of currently selected table within document.
Add this function to any your Module:
Function WhichTableNo(RNG As Range)
If RNG.Tables.Count > 0 Then
Dim DOC As Document
Set DOC = RNG.Parent
Dim rngTMP As Range
Set rngTMP = DOC.Range(0, RNG.Tables(1).Range.End)
WhichTableNo = rngTMP.Tables.Count
Else
WhichTableNo = "Not in the table"
End If
End Function
and to check the table number you could call it this way:
debug.Print WhichTableNo(Selection.Range)
As a result you get number of table you are currently in.
The table in which your cursor is is always Selection.Tables(1).
If Selection.Tables.Count > 0 Then
Dim r As Range
Set r = Selection.Tables(1).Range
r.Collapse wdCollapseEnd
r.Select
End If
In case of nested tables, you might want to also check Selection.Tables.NestingLevel. The following will exit any number of nested tables, placing the cursor after the outermost table:
If Selection.Tables.Count > 0 Then
Dim r As Range, i As Long
Set r = Selection.Range
For i = 1 To r.Tables.NestingLevel
Set r = r.Tables(1).Range
r.Collapse wdCollapseEnd
Next
r.Select
End If
Related
The main VBA procedure counts characters in table cells in a Word document. Since it can count characters different ways:
Count the "Objective" text for the selected table
Count the "Accomplishment" text for the selected table
Count both the Obj and Acc texts in each table (loop), for all tables (another loop)
I created calling procedures for each option above that calls the main procedure. This way I pass variables from the calling Sub to the main Sub. These variables (1) tell the main Sub whether I want to count what is in row 3 (objective) or in row 5 (accomplishment) or both, and (2) feed the If/then lines in the main Sub to make sure the right row is counted. At the time, it seemed elegant, in hindsight - not so much.
Word template below:
There will be text in O1 and the VBA will count it (characters, spaces + paragraphs) and output it in C1, and the C1 fill changes red or green if over/under the character limit. The same for A1 and C2 and so on for any number of following tables.
PROBLEM DESCRIPTION
The VBA was working for the actions above when I had the row/columns hard coded into various places in the code. If rows/columns were ever added/deleted from the tables, they would have to updated in multiple spots. It would be simpler if the row/column numbers were in one place and referred back to as variables, so I changed the row/col #s to public variables. Then the problem began.
In the code, I track (debug.print) what becomes of oRow (output row) & chcct (character count col) and both are 0 as the main Sub runs, despite both being initialized as 3 in the public Sub Row_Col_Num() below.
My public variables are at the top of the module before the first Sub() and denoted as Public. Sub Row_Col_Num() which contains the variable assignments is also Public. All Subs are in the same standard module.
Option Explicit
Public oRow As Integer 'row with "Objectives" text
Public aRow As Integer 'row with "Accomplishments" text
Public cOnA As Integer 'column that both obj and accmp text are in
Public cChCt As Integer 'column that the char count is output to
Public Sub Row_Col_Num()
oRow = 3
aRow = 5
cOnA = 1
cChCt = 3
Debug.Print "cchct pub sub: " & cChCt
End Sub
ATTEMPTS TO FIX PROBLEM & RESULTS
I used the variable normally and left it Public as well as the Sub that assigns the variables (oRow =3) values.
Sub TableCharCount_Obj()
'Run character count for the "Objectives" in the SELECTED table
Debug.Print "orow = " & oRow
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
I tried putting the Sub() name in front of the variable when it is used, e.g. Row_Col_Num.orow, in the Sub above.
Call TableCharCount(Row_Col_Num.oRow, Row_Col_Num.oRow)
I tried the module name in front of the variable as well, e.g. Module1.orow.
Call TableCharCount(Module1.oRow, Module1.oRow)
RESULTS
#1 & #3 resulted in the macro counting the wrong row and outputting to the wrong cell.
#2 resulted in error "Expected Function or variable" at line: Call TableCharCount(Row_Col_Num.oRow, Row_Col_Num.oRow)
All 3 cases orow and cchct both continued to be 0 throughout the run.
QUESTIONS / SOLUTIONS
a) Can a Public variable (oRow) be used as an argument passed from calling Sub to called Sub as ByVal a As Integer?
b) Does Public Sub Row_Col_Num(), which assigns values to the public variables, have to be explicitly run or called to populate the variables in the other Subs w/ the correct values?
c) Should I call Public Sub Row_Col_Num() in every calling Sub before calling the main Sub?
Sub TableCharCount_Obj()
Call Public Sub Row_Col_Num() '<<< add this call
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
This option seems like a bad design.
If it's not obvious, there was some mission creep as I added more capability For now, if I could get the public variables to work, it would be done. Appreciate any suggestion to get these variables to work. For the purposes of this question, I only left the code for the variable Sub, the first calling Sub and the main Sub. VBA below:
'#0 -- This creates variables for column and row number used in all the macros. Only need to change row/col number here if row/col are added/deleted
Option Explicit
Public oRow As Integer 'row with "Objectives" text
Public aRow As Integer 'row with "Accomplishments" text
Public cOnA As Integer 'column that both obj and accmp text are in
Public cChCt As Integer 'column that the char count is output to
'This assigns row/column numbers to the variables
Public Sub Row_Col_Num()
oRow = 3
aRow = 5
cOnA = 1
cChCt = 3
Debug.Print "cchct pub sub: " & cChCt End Sub
'#2
Sub TableCharCount_Obj() 'Run character count for the "Objectives" in the SELECTED table
Debug.Print "orow = " & oRow
Call TableCharCount(oRow, oRow) 'provide it 2x to make IF and FOR loop
End Sub
'other calling procedures removed
'#5
Option Explicit
Sub TableCharCount(ByVal a As Integer, ByVal b As Integer)
'Counts total characters in a cell w/in a table and outputs the number to a different cell, and colors the cell red or green if over/under the maximum number of characters.
Dim charCount, charWSCount, paraCount, charTot As Double
Dim iRng, oRng, txtRng As Word.Range
Dim i, max, s, t, x As Integer
Dim tcount, tbl As Integer
Dim DocT As Table 'for active doc tables
Debug.Print "cchct1= " & cChCt 'Debug.Print vbCr & "-----START-------" & vbCr Application.ScreenUpdating = False
If a <> b Then
tcount = ActiveDocument.Tables.Count
tbl = 1 'used in FOR loop, start w/ table #1
s = b - a '"STEP" used in FOR loop = # of rows between objectives text and accomplishments text Else
On Error GoTo ErrMsg 'handles expected user error of not selecting a table to execute on
tbl = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count 'ID the table that is selected
tcount = tbl 'prevents FOR loop from trying to run again
s = 1 '"STEP" used in FOR loop = # of rows between objectives text and accomplishments text / do not set to zero = infinite loop End If
'Debug.Print "# of Tables: " & tcount
For t = tbl To tcount 'loops thru the tables
Set DocT = ActiveDocument.Tables(t)
For x = a To b Step s 'loops thru the applicable row(s) in the table
'Debug.Print "x # start = " & x
'Debug.Print "table " & t
iRng = DocT.Cell(x, cOnA)
iRng.Select
'Count used in output
Selection.MoveLeft wdCharacter, 1, wdExtend 'computerstats requires the text itself selected, characters.count can use the whole cell selected
charWSCount = Selection.Range.ComputeStatistics(Statistic:=wdStatisticCharactersWithSpaces) 'counts bullets & space after bullet / not line breaks (paragraphs)
'Debug.Print "Comp statchar# " & charWSCount
'---------
paraCount = Selection.Range.ComputeStatistics(Statistic:=wdStatisticParagraphs)
'Debug.Print "#paras = " & paraCount
'----------
charTot = charWSCount + paraCount
'Output to table cell
i = x - 1 'output cell is 1 row above cell that is counted
Set oRng = DocT.Cell(i, cChCt).Range 'Char count ouput row,column
Debug.Print "cchct2= " & cChCt
oRng.Text = charTot
Set txtRng = DocT.Cell(i, cChCt - 1).Range '"# Char:" location row,column
txtRng.Text = "# Char:"
'Maximum # of char allowed in a cell. Used to change cell fill red or green.
max = 2000 '"Accomplishment" row (row 5) has a max of 2000
If i = 2 Then max = 1500 '"Objective" row (row 3) has a max of 1500
'Change color of cell to indicate over/under max # of characters
If charCount < max Then
oRng.Shading.BackgroundPatternColor = wdColorBrightGreen
Else: oRng.Shading.BackgroundPatternColor = wdColorRed
End If
'Debug.Print "x # end = " & x
'Debug.Print "--------Next x--------------"
Next x
'Debug.Print "------Next Table------"
Next t
ActiveDocument.Tables(tbl).Select 'attempt to move to top of 1st table if using CharCount_AllTab() or just to the top of the selected table for the other macros
Selection.GoTo What:=wdGoToBookmark, Name:="\Page" Selection.StartOf
Application.ScreenUpdating = True
Exit Sub
ErrMsg: Msgbox "Select a table by placing the cursor anywhere in the table. Press OK and try the macro again numnuts!", _
vbOKOnly, "Table not selected"
End Sub
I am trying to add text as subscript in a Table Cell in a Word-Document using VBA.
I currently have this code, it is a part of the loop in which I insert my values into the table.
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = False
wordArray = Split(ws.Cells(i, j), "_")
For k = LBound(wordArray) To UBound(wordArray)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.InsertAfter wordArray(k)
ActiveDocument.Tables(ActiveDocument.Tables.Count).Cell(i, j).Range.Font.Subscript = wdToggle
Next k
So I split the text that is in ws.Cells(i,j) on "_"
This can become an array of length 1,2 or 3
Only the second element of the array must be subscript.
My current code should do that, however, it writes the value into the cell based on the last value of Font.Subscript, so either fully normal or fully subscript.
So what I actually want in my table cell is the following
If the ws.Cells has for example a_b_c then b should be subscript and a and c normally written in the table cell. How do I need to change my code to accomplish that?
Since you haven't provided a mvce you'll need to adapt the following example to your needs - . It's main purpose is to demonstrate how to insert text and format it, which is done in the For loop.
Please note how to declare and instantiate a Table object - this is more reliable and more efficient than repeating ActiveDocument.Tables[index].
Use a Range object to write the data to the table cell. Important is "collapsing" the range so that the content is appended, rather than over-written. You need to write a separate range object for each formatting variation.
The code below checks whether the second member of the array is being written. If yes, it's formatted as subscript, if it's another member, then no subscript.
Sub CellContentWithSubscript()
Dim tbl As Word.Table
Dim rng As Word.Range
Dim wordArray '() As Variant
Dim data As String, k As Long
Set tbl = ActiveDocument.Tables(1)
data = "PartOne_Part two_Part three"
wordArray = Split(data, "_")
Set rng = tbl.Cell(1, 1).Range
rng.Collapse 0
rng.MoveEnd wdCharacter, -1
For k = LBound(wordArray) To UBound(wordArray)
rng.Text = wordArray(k)
If k = 1 Then
rng.Font.Subscript = True
Else
rng.Font.Subscript = False
End If
rng.Collapse 0
Next k
End Sub
I've been using the code below from jonhaus.hubpages.com to remove the empty columns I have.
'Delete empty columns
Dim c As Integer
c = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
Do Until c = 0
If WorksheetFunction.CountA(Columns(c)) = 0 Then
Columns(c).Delete
End If
c = c - 1
Loop
However, as I've been writing the VBA, it's gotten kinda bloated and slow... I'm trying to optimize and streamline my code by eliminating loops, copy/pastes, etc.
Do y'all have suggestions for code that would do the same thing (deleting entire emtpy columns) WITHOUT requiring looping "Do Until/If/End If/Loop" statements?
References:
http://jonhaus.hubpages.com/hub/Excel-VBA-Delete-Blank-Blank-Columns
http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
Expanding on my comment above, create the range inside the loop, but delete it only once.
Dim c As Integer
Dim rngDelete As Range
c = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
Do Until c = 0
If WorksheetFunction.CountA(Columns(c)) = 0 Then
'Combine each empty column:
If Not rngDelete Is Nothing Then
Set rngDelete = Application.Union(rngDelete, Columns(c))
Else
Set rngDelete = Columns(c)
End If
End If
c = c - 1
Loop
'Deletes ALL empty columns at once:
rngDelete.EntireColumn.Delete
The other obvious improvements are to disable Application.ScreenUpdating and set Application.Calculation = xlManual during run-time. (remember to restore their normal functionalities at the end of subroutine.
I am fairly new to VBA and having some general obstacles with basic syntax. I am using the below code to trim leading spaces and color code an ActiveSheet I am currently working on.
I have another Worksheet called "Country" that I would like to apply the same logic to the current sheet I am using. I am also having difficulties using the most efficient code to find any cells with values of "AcctTotal" , " CurrTotal" and " BravoTotal" (there are about 14,000 rows of data). I am currently highlighting the whole spreadsheet and utilizing "UsedRange" to find these cells.
To sum it up:
I would like to trim leading spaces and color code any values of "AcctTotal" , " CurrTotal" and " BravoTotal" in two worksheets: "Currency" and "Country"
Sub ColorCodeCurrency()
Dim r As Range
For Each r In Selection
If r.Value = " AcctTotal" Then
r.Value = LTrim(r.Value)
Intersect(r.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 15
End If
Next r
Dim s As Range
For Each s In Selection
If s.Value = " CurrTotal" Then
s.Value = LTrim(s.Value)
Intersect(s.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 40
End If
Next s
Dim t As Range
For Each t In Selection
If t.Value = " BravoTotal" Then
t.Value = LTrim(t.Value)
Intersect(t.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 35
End If
Next t
End Sub
Most of the problem is that you're doing the same thing three times. The 'For Each' statement is going through every cell three times. If you joined it into
for each r in selection
if r.value ="AcctTotal" then
'do something
elseif r.value = "CurrTotal" then
'do something else
elseif r.value = "BravoTotal" then
'do the third thing
end if
In addition to what Maudise said, when you refer to your data, you can use syntax like:
Sheets("Country").Range("A1:E14000")
If it's possible to make changes to your source data, you may find it helpful to format it as a table for easy reference. Use the Name Manager to give the table a useful name. Then, you can say something like:
For Each r In Sheets("Country").Range("CountryTable")
You could try this way:
Public Sub ColorCode ()
Dim i As Integer, j As Integer, m As Integer, n As Integer
i = Range("A:A").End(xlDown).Row
j = Cells.End(xlToRight).Column
For m = 1 To i
For n = 1 To j
If Cells(m, n).Value < 50 Then
Cells(m, n).Interior.ColorIndex = 13
End If
Next n
Next m
End Sub
One solution is to call this code placed in a module into "This workbook" in "Private Sub Workbook_Open()".
I have vba that produces a flat text file of the selected column.
The issue is that the process takes a while because usually the column letter is clicked and the whole column is highlighted including all the unused cells.
How can i get the macro to stop processing when it finds the first empty row?
Here is my code.
Sub testlist()
Open "C:\Users\gaum\Desktop\Work\NCL\testlist.lst" For Output As #1
For NR = 1 To Selection.Rows.Count
For NC = 1 To Selection.Columns.Count
ExpData = Selection.Cells(NR, NC).Value
If IsNumeric(ExpData) Then ExpData = Val(ExpData)
If IsEmpty(Selection.Cells(NR, NC)) Then ExpData = ""
If NC <> NumCols Then
If Not ExpData = "FilePath" Then Print #1, ExpData
End If
Next NC
Next NR
Close #1
End Sub
Also am i able to get the macro to produce the output if i have multiple selections i.e ctrl and left click various cells, it currently only outputs the first highlight.
Many Thanks
Since you asked 2 separate questions, I will address them both separately.
The easiest way to stop processing when you encounter a blank row is to add a check before your 2nd For..Next loop. The issue is how to check. The simplest way to check if an entire range is empty is to use the CountA worksheet function.
If WorksheetFunction.CountA(Range(NR & ":" & NR).EntireRow) = 0 Then Exit For
The above will basically use the worksheet function CountA and count the number of cells within the range that are not blank (using CountA is important here as the Count worksheet function will only count numeric cells and not non-numeric ones, whereas CountA will count anything except blanks. The other advantage you get by using the WorksheetFunction object is you can adjust the Range object as you need if you only want to check a few columns and the not the entire row by just specifying the specific Range and not using .EntireRow.
The next question is how to deal with multiple selected ranges. There is another member of the Selection class called Areas, which should given you the functionality you need. Areas is a collection that has the ranges for each individual selection range you make.
You can reference each selection range independently by using the 1-based index of the selection:
NumAreaRows = Selection.Areas(1).Rows.Count 'gets the number of rows in the first selected range
NumAreaCols = Selection.Areas(2).Columns.Count 'gets the number of columns in the second selected range
So you could put both all together into your solution:
Sub testlist()
Open "C:\Users\gaum\Desktop\Work\NCL\testlist.lst" For Output As #1
For NA = 1 To Selection.Areas.Count
For NR = 1 To Selection.Areas(NA).Rows.Count
If WorksheetFunction.CountA(Range(NR & ":" & NR).EntireRow) = 0 Then Exit For
For NC = 1 To Selection.Areas(NA).Columns.Count
ExpData = Selection.Areas(NA).Cells(NR, NC).Value
If IsNumeric(ExpData) Then ExpData = Val(ExpData)
If IsEmpty(Selection.Areas(NA).Cells(NR, NC)) Then ExpData = ""
If NC <> NumCols Then
If Not ExpData = "FilePath" Then Print #1, ExpData
End If
Next NC
Next NR
Next NA
Close #1
End Sub
The placement of the CountA function and the Exit For statement here allows you to loop through each selected range independently and it won't exit completely if you have a blank row in one of the ranges.
Given this process takes a while, you would be better off going beyond stopping at a blank cell, and removing the inefficient range loop altogether. The code below
Uses a variant array rather than range
removes the redundant two-step IF test (if ExpData is numeric it cannot also be "FilePath")
code
Sub testlist()
Dim X
Dim lngCnt As Long
X = Selection
If IsEmpty(X) Then Exit Sub
Open "C:\Users\gaum\Desktop\Work\NCL\testlist.lst" For Output As #1
For lngCnt = 1 To UBound(X)
If Len(X(lngCnt, 1)) = 0 Then Exit For
If IsNumeric(X(lngCnt, 1)) Then Print #1, Val(X(lngCnt, 1))
Next
Close #1
End Sub