I have a word document with tables throughout.
I have a macro that I use to copy values from cells in certain columns and paste them into other columns. Then the macro deletes several columns from the table.
Generally I use bookmarks for the copying and pasting.
The Bookmarks are all cells in a specific column, except the header.
So for example "Objectives" bookmark would span from row2 of column 2 of table5, until the end of column2. So if the user adds a row, that would also be included in the bookmark.
Here is an example below:
If ActiveDocument.Bookmarks.Exists("ProposedOverallObj") = True Then
ActiveDocument.Bookmarks.Item("ProposedOverallObj").Select
Selection.Cut
Selection.GoTo What:=wdGoToBookmark, Name:="Objectives"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.PasteAndFormat (wdPasteDefault)
End If
Dim Table1 As Table
Set Table1 = ThisDocument.Tables(5)
If Table1.Columns.Count >= 5 Then
With Table1
.Columns(5).Delete
.Columns(4).Delete
.Columns(3).Delete
End With
Else
MsgBox "Not enough columns!"
End If
and it goes on like this for about 13 tables. The first few tables work fine, then i start running into a weird error where randomly the line of text above my table gets copied into the table header and then my "delete columns" code breaks and tells me that one of the columns has already been deleted. (it hasn't).
Is there a better way to do this? Might this be happening because I am using .Select? I know it can be sketchy. Would it be better to assign IDs to my column ranges rather than using bookmarks and select? if so, could you provide me with a small example code for using Dim on a range in a table (my range will always start on row2 and go to the end of the column)?
example of tables in the spreadsheet
Hi I am new to VBA and wanted to create a macro that can auto fill column "Y/N" (as shown in the attached pic) with the text "Yes" by clicking a button.
Right now I have 3 rows in the first table, which is fine and I used the following code:
Sub autofill1()
Range("E12").Value = "Yes"
Range("E12").Select
Selection.AutoFill Destination:=Range("E12:E14")
End Sub
However, the rows in the first table will keep changing, say it becomes 20, 50, 100 depending on different cases. I wonder if there's a way for me to define the auto fill range to be cell E12 to the last cell in this table, not to extend to the rest of the tables below.
I checked the codes provided for other similar questions - looks like it will auto fill all the way down to the last cell in my worksheet, which is the last cell in this column of the 5th table. And I don't want that. Is there a way to only auto fill down to the last cell of the 1st table? Thanks so much in advance!
In my opinion, adding "yes" until found a bottom border.
Sub autofill1()
'Range("E12").Value = "Yes"
'Range("E12").Select
'Selection.AutoFill Destination:=Range("E12:E14")
Dim i As Long
i = 11
Do While Range("E" & i).Borders(xlEdgeBottom).LineStyle _
= xlNone
i = i + 1
Cells(i, 5) = "Yes"
Loop
End Sub
Introduction
I have some spreadsheets like the following.
Here the header is on rows 16 and 17. There is a "header" to the left (not shown) among the earlier rows and columns that includes a picture, some non-tabular data, a legend, etc., that is unimportant here. Header text on row 16 is obfuscated because reasons. Data marked in bold red indicates that that sample point has undergone some process. Here is the code snippet from the script that highlights those data points in bold red.
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
Selection.AutoFilter ' Turn on autofiltering (hopefully)
Selection.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e"
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Selection.AutoFilter ' Turn off autofiltering
Columns(ColumnLetter(currIndex + 1) & ":" & ColumnLetter(currIndex + 1)).EntireColumn.Delete Shift:=xlToLeft
End If
End If
Next currIndex
Context
Here, abcDateCol refers to column AE, lastCol refers to column AQ, abcDateRow (not shown, but available) and abcDateRowDesc refer to the header rows 16 and 17 respectively, and the ColumnLetter function is a user-defined function that returns the human-readable column letter(s) given a column number; this is common functionality you may have seen elsewhere, or even made yourself.
Let's Continue
Never mind that the condition in If Cells(abcDateRowDesc, currIndex).Value() = "Comments" is never satisfied because of an oversight (I'm assuming) -- two different rows, guaranteed.
Let's take a look at what the spreadsheet looks like before this script is executed.
So, the script takes pairs of columns, and for each pair of columns it marks data cells bold red if a data cell's right-adjacent cell has a 1 (or an "e"?) (as a boolean; answers the question, "Has this sample point undergone whatever process?") and then trashes the "process" column.
The Problem
A client wants the gratuitous header gone, so they may more easily import the spreadsheet into whatever solution they have. Delete rows 1 through 15, and this is what I get.
What in the bleepity-bleep happened to the header? I don't understand how this first row gets highlighted. It seems too perfectly weird. Now, let's revisit the very first spreadsheet.
I've filled the "header" with some dummy text after the script executed. Wow, there's the first row reddened again, this time ad infinitum! So, this problem has always existed. Oh, and the first column, too! And, it magically stops right above the proper header so we would never see it.
The Questions
Why is this script unexpectedly reddening the first row and column? Can this be easily solved, or am I looking at some sort of a rewrite? If so, please point me in the general direction.
It helps to mention that these spreadsheets are generated from a Windows application and their scripts executed before a user has a copy of their spreadsheet. Also, regarding the second picture (the spreadsheet with the "process" columns shown), this spreadsheet is not something that normally exists. I generated it for the sake of this post by skipping the script's for loop. The application uses a chosen spreadsheet template, that looks the same minus the data, fills in the sample data, and then executes several scripts over the data.
I considered using conditional formatting, but there are a few dozen spreadsheet templates. Even if I just change the one I need, I can't change the fact that these common scripts run over it. I feel my best option is to correct the script. And, I wouldn't change the script to account for my edge case. The whole ecosystem feels flaky, but that's just subjective.
Note
I am not the author of this script (or any of my company's VBA!). I'm considering this an inheritance tax levied upon me.
*Update
I was asked if I traced through this code. I apologize that I didn't include that information in my original post. Here is what I know. Selection.Font.ColorIndex = 3 turns the cells in the selection that satisfy the autofilter plus the first row (two cells as only two columns are selected at a given time), and Selection.Font.Bold = True makes the same cells bold in the same manner. I suspect it has something to do with the autofilter, so I'm going to take a look at the answers now.
This edit should fix your problems, hopefully (they did for my remake of your spreadsheet, but we won't know til you try on the real thing)
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
'Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
With Range(Cells(abcDateRowDesc, currIndex), Cells(abcDateRowDesc, currIndex + 1).End(xlDown))
.AutoFilter 2, "=1", xlOr, "=e"
' Don't format header
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) .Font.ColorIndex = 3
.Font.Bold = True
.AutoFilter ' Turn off autofiltering
End With
End With
Columns(currIndex + 1).Delete xlShiftLeft
End If
End If
Next currIndex
This all starts with a quirk of how the code is choosing its range to autofilter. The selected area is the full column, instead of the area you actually want to format (row 18 to the last entry). It seems that autofiltering on a full column with empty top rows automatically sets the first nonempty row as the header row. So the header is left unfiltered/unhidden by the statement, and it gets colored in as part of the full column selection. So that's why your headers are getting colored.
Now, if you tried to test this by putting data in the above empty rows like "a", those values would become the first ones in the column and would be selected as the headers - meaning those values get colored. Whatever is in the first nonempty row of your columns will be the autofilter header and will get colored.
But that should only affect the columns you explicitly colored, not the entirety of the first row, right? The problem here is that Excel likes to make assumptions about data in order to save time. So if you have a whole row full of red, bold "a"'s and right next to them you put in another "a" to test whether that cell is formatted or not... well, it automatically gives you a red, bold "a" despite the cell being previously unformatted! And if you keep going down the row in this way, it'll appear like your whole row got formatted. But, if you were to jump over a few columns (say, 5-ish) and enter in another "a", voila, it's unformatted, and any "a"s you put in near it will be too. You can also check what Excel by deleting an unformatted "a" in a far off column, then continuing to enter "a"'s all the way down until you reach that same cell - this time, the "a" will be red and bold because all of the others in the row were, too, even though we just checked that this was an unformatted cell!
Basically, having the wrong range for your autofilter made things act very unexpectedly, then trying to test the formatting issue by entering in values just made everything less clear. The code I've provided just autofilters the relevant area (row 17 to the last contiguous row), fixing the core issue.
here's a (commented) refactoring of your code that should do:
Option Explicit
Sub main()
Dim abcDateCol As Long, lastCol As Long, abcDateRow As Long, abcDateRowDesc As Long, currIndex As Long
abcDateCol = 31
lastCol = 43
abcDateRow = 16 '<--| you can change it to 1 for the last "scenario"
abcDateRowDesc = 17 '<--| you can change it to 2 for the last "scenario"
For currIndex = abcDateCol + 1 To lastCol '<--| loop through columns
With Cells(abcDateRow, currIndex) '<--| refer to cell in current column on row abcDateRow
If .Value = "Comments" Then Exit For '<--| Check for exit conditions on row 'abcDateRow'
If .Offset(1).Value <> "" And .Offset(1, 1).Value = "process" Then '<--| Check for processing conditions on row 'abcDateRowDesc'
With .Resize(.Offset(, 1).End(xlDown).Row - .Row + 1, 2) '<-- consider the range from current referenced cell 1 column to the right and down to last 'process' number/letter
.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e" '<--| filter on "process" field with "1" or "e"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any values match...
With .Offset(2).Resize(.Rows.Count - 2, 1).SpecialCells(xlCellTypeVisible).Font '<--|... consider only filtered values skipping headers (2 rows), and apply formatting
.ColorIndex = 3
.Bold = True
End With
End If
.AutoFilter '<-- reset autofilter
.Resize(, 1).Offset(, 1).EntireColumn.Delete Shift:=xlToLeft '<-- delete the "2nd" column (i.e. one column offsetted to the right)
End With
End If
End With
Next currIndex
End Sub
there were two faults in your "inherited" code:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For was to be referred to abcDateRow index row instead
the formatting would be applied to all cells, were they filtered (matching) or not
I wrote a program that creates a table in Word which is filled with values from a database. That works fine so far.
The first column of that table shall contain categories for items in the table and those categories should be merged cells with the span of all items in that category. Basically this is working.
Here's the code
'Select the first cell of a category in column 1
wordtable.Cell(categoryPos, 1).Select()
'Move down till all cells of column 1 in rows with items of that category are selected
word.Selection.MoveDown(wordoptions.WdUnits.wdLine, (numberMachines - 1), wordoptions.WdMovementType.wdExtend)
'then I change the rotation, background-color, write text etc.
The problem is the page break. After a page break the listing looks like on this picture:
I need to know a method of selecting multiple cells without the Move-command.
If this was Excel I would do something like
ActiveSheet.Range(Cells(x1, y1), Cells(x2, y2)).Select
Selection.Merge()
But since Words range is only one-dimensional I'm kinda stuck here.
Someone got a hint?
Sometimes it's easier than expected:
Dim r As wordoptions.Range
r = doc.Range( _
Start:=wordtable.Cell(kategorypos, 1).Range.Start, _
End:=wordtable.Cell((kategorypos + numberMachines - 1), 1).Range.End)
r.Select()
I'm trying to delete columns from a table which has horizontally merged cells
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
Eventhough columns are getting deleted, merged cells are removed in the process leaving a broken table.
Almost similar approach to delete rows works fine as explained in this answer
Workaround
I'm doing something like this as work around
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.MoveDown Unit:=WdUnits.wdLine, Count:=2, Extend:=wdExtend
Selection.Cells.Delete
Then setting width of Cell at index 1,2 to rest of the table rows. This way you can avoid merged cell getting deleted.
Word tables are not always intuitive. If a cell spans a column that is to be deleted, then the ENTIRE spanned cell will always be deleted, as you have shown.
When I'm NOT using VBA, I always unmerge cells before deleting rows or columns; otherwise Word's behavior is hard to predict.
Using VBA I would suggest the following:
'splits the header row of the current table into 7 cells
Selection.tables(1).cell(1,2).split numrows:=1, numcolumns:=7
'your code to delete columns
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
'merge the header row back into one span
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,5).range.end _
).cells.Merge
or for a more general approach, to delete n columns:
width = Selection.tables(1).columns.count - 1
Selection.tables(1).cell(1,2).split numrows:=1, _
numcolumns:= width - 1
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:= n
Selection.Columns.Delete
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,width-n-1).range.end _
).cells.Merge
This should do it
Sub DeleteCols()
Dim Col2Delete As Range
Set Col2Delete = Selection.EntireColumn
Col2Delete.Delete
End Sub
First of all, we must look at the table not as rows/columns, but as indexed cells. (fig.1)
Now, we should select a range that starts from second cell and end to the last cell.
Finally, delete selection columns
Set Rng = Tbl.Range.Cells(2).Range
Rng.End = Tbl.Range.Cells(Tbl.Range.Cells.Count).Range.End
Rng.Select
Selection.Columns.Delete