I'm trying to add comments to the table rows. the idea is that you select a table and the macro would add a comment to every row.
say you have a string followed by an integer in the comment content.
example comment content would be :
comment1
comment2
comment3
Note that the contents of the comments are important , as they play a vital role.
Here is what I got so far , if some one has already got this figured out , please help me out
Sub CallAddNewComment()
Dim i As Integer
i = ActiveDocument.Tables(1).Rows.Count
Do Until (i > 1)
Call AddNewComment(strText:="This is a test comment.")
Loop
End Sub
Sub AddNewComment(ByVal strText As String)
Comments.Add Row = i, Text:=strText
End Sub
Sub Tester()
Dim tbl As Table, i As Long
For Each tbl In ActiveDocument.Tables
For i = 1 To tbl.Rows.Count
ActiveDocument.Comments.Add _
tbl.Rows(i).Cells(1).Range, "Comment" & i
Next i
Next tbl
End Sub
Related
I'm trying to change the Tag of a bunch of CheckBoxes (Content Control), so the tags match the CheckBox row position on a table.
Ex.: If CheckBoxes are positioned on row 4, i want all of them to have the same tag (like Row4,or something like that).
Is this possible or the Tag property is only for reading purpose?
I'll be gratefull on any advise. Thanks in advance!
Image of the table bellow
A basic example:
Sub Tester()
Dim cc As ContentControl, i As Long, tbl As Table, rw As Row
Set tbl = ThisDocument.Tables(1)
For Each rw In tbl.Rows
i = i + 1
For Each cc In rw.Range.ContentControls
If cc.Type = wdContentControlCheckBox Then
Debug.Print cc.Tag
cc.Tag = "Row_" & i
End If
Next cc
Next rw
End Sub
I have the macro called "macro3" to runs in sheet1
and I have cells B7 in sheet2 that contain the value, lets say "12"
how to runs the macro 12x (based on value in cells B7 in sheet2) with one button?
Welcome to StackOverflow! Make sure that the next time you ask a question you read the rules - https://stackoverflow.com/help/how-to-ask
Concerning this question - take a look at the code below, it is a for-loop:
Public Sub TestMe()
Dim timesToRun As Long
Dim cnt As Long
timesToRun = Worksheets(2).Range("B7")
For cnt = 1 To timesToRun
macro3
Next cnt
End Sub
I suggest doing the following:
Sub RunMacro()
Worksheets("sheet2").Select
Dim MacroCounter As Integer
MacroCounter = Range("B7").Value
For x = 1 To MacroCounter
Call macro3
Next x
End Sub
I am working with VBA for the first time in a long time and need some help with adding a table into the document.
the line in question at the moment is
.Cell(1, x).Range.Select
and the error that I get is object variable or with block variable is not set. and for the life of me I cannot see where I am going wrong on this one.
I am passing in a 3 dimensional string array that I am looking to pass into a table and this is the code I am working with at the moment
Private Sub Create_Sized_Table_Multi_Column(i_Rows As Integer, i_Columns As Integer)
'create a table
Set t_newtable = ActiveDocument.Tables.Add(Selection.Range, i_Rows, i_Columns)
End Sub
Private Sub BuildTable(arr() As String, colCount As Integer, bookMark As String)
Dim t_newtable As Table
Dim i_Fund_Quantity As Integer
Dim i_Rows_Required As Integer
Dim i_Columns_Required As Integer
'Number of funds is the upperbound + 1 to allow for the zero relative
i_Fund_Quantity = UBound(arr) + 1
'header Row
i_Rows_Required = UBound(arr) + 1
'Number of columns
i_Columns_Required = colCount
'Add a table - this table will contain moved funds
'creates the table dimensioned by i_rows x i_column
Create_Sized_Table_Multi_Column i_Rows_Required, i_Columns_Required
'Now populate the header row
With t_newtable
For x = 0 To i_Columns_Required
.Cell(1, x).Range.Select
If x = 1 Then
Set_Table_Headers "Existing Fund"
ElseIf x = 2 Then
Set_Table_Headers "Customer Name"
ElseIf x = 3 Then
Set_Table_Headers "Switch To"
ActiveDocument.Bookmarks.Add ("bk_Switched_Table")
End If
Next
End With
'Populate the table with the fund details
''//sp write to table here
With t_newtable
'Position cursor at first insertion point
'ActiveDocument.Bookmarks("bk_Switched_Table").Select
'Now create a loop
For i_Loop_Rows = 0 To UBound(arr)
Set_Table_Rows
Selection.TypeText arr(i, 0)
Selection.MoveRight UNIT:=wdCell
Selection.TypeText arr(i, 1)
Selection.MoveRight UNIT:=wdCell
Selection.TypeText arr(i, 2)
t_newtable.Columns(3).Select
t_newtable.Columns.AutoFit
Selection.Collapse Direction:=wdCollapseEnd
Next
End With
ActiveDocument.Bookmarks(bookMark).Select
Selection.TypeParagraph
Selection.TypeText s_Text
Selection.TypeParagraph
ActiveDocument.Bookmarks.Add (bookMark)
End Sub
I would be grateful if someone could review this and let me know where I have gone wrong and what I need to change.
thanks
Simon
You declare t_newtable in the procedure Create_Sized_Table_Multi_Column, so it will be limited to that scope. If you want to call that procedure, have it create the table, then make it available to the code that called it, you need to change the Sub into a Function and have the function return the table.
For example:
Private Function Create_Sized_Table_Multi_Column(i_Rows As Integer, _
i_Columns As Integer) As Table
'create a table
Set Create_Sized_Table_Multi_Column = ActiveDocument.Tables.Add( _
Selection.Range, i_Rows, i_Columns)
End Function
Then you use it like this (code shortened for clarity):
Private Sub BuildTable(arr() As String, colCount As Integer, bookMark As String)
Dim t_newtable As Table
'Add a table - this table will contain moved funds
'creates the table dimensioned by i_rows x i_column
Set t_newtable = Create_Sized_Table_Multi_Column(i_Rows_Required, _
i_Columns_Required)
End Sub
Note the added parenthesis around the call to the function. These are required when something is to be returned from a call.
You never set t_newtable in your BuildTable sub. If you have to create your table somewhere else, then you have to
Set t_newtable = ActiveDocument.Tables(indexOfYourTable)
which will instantiate your t_newtable to the object you want it to be. NOTE: indexOfYourTable is 1 based not 0 based.
OR
You can put the line of code in your Create_Sized_Table_Multi_Column sub inside your BuildTable sub and pass the variables needed into your BuildTable sub.
Sub SeperateRowSub()
Dim FirstRowPFW As Integer
Dim LastRowPFW As Integer
FirstRowPFW = Range("B:B").Find(what:="Planning/Fieldwork", after:=Range("B6")).Row
LastRowPFW = Range("B:B").Find(what:="Planning/Fieldwork", after:=Range("B6"), searchdirection:=xlPrevious).Row
End Sub
FirstRowPFW returns the correct row that it starts at.
Lastrow continues to count the rest of the rows, even those outside of the "planning/fieldwork" criteria.
How can I fix the lastrowpfw variable to only count to the last row for cells containing "Planning/Fieldwork" ?
You code appears to function with correct data:
Sub SeperateRowSub()
Dim FirstRowPFW As Integer
Dim LastRowPFW As Integer
FirstRowPFW = Range("B:B").Find(what:="Planning/Fieldwork", after:=Range("B6")).Row
LastRowPFW = Range("B:B").Find(what:="Planning/Fieldwork", after:=Range("B6"), searchdirection:=xlPrevious).Row
MsgBox FirstRowPFW & vbCrLf & LastRowPFW
End Sub
I found that the problem was it was referencing a formula for Planning/Fieldwork, i.e. that text came up conditionally. When I put a hardcoding statement in for that reference, it works. Thank you for your help anyway!
I'm looking for a way to delete empty rows in comments using VBA. I have an Excel file with loads of corrupted comments, containing empty rows, and going through them one by one is not an option.
I haven't identified a command for editing rows in comments, and don't know where to start, so I don't have any code to show you guys. But I'm thinking in the line of:
For Each comment In ActiveSheet.Comments
"REMOVE EMPTY ROWS" <-- What to put here?
Next comment
Hope that you can help me anyway!
EDIT:
All my empty lines are at the end of the comment like this:
I found the answer. It seems that it's not empty rows, it's just the size of the comment that was changed somehow. So this code fixed it:
Sub Comments_AutoSize()
Dim MyComments As Comment
Dim lArea As Long
For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.1
End If
End With
Next
End Sub
Suppose your comment looks like this
You could try this
Sub RemoveEmptyLinesInComments()
Dim c As Comment
For Each c In ActiveSheet.Comments
c.Text Text:=Replace(c.Text, vbLf, Chr(32))
Next c
End Sub
to achieve
Update
Ok, after you've edited your question and changed the meaning with the provided details Ive come up with another code as a solution. Try
Sub RemoveEmptiesFromComments()
Dim c As Comment
For Each c In ActiveSheet.Comments
Dim v As Variant
v = Split(c.Text, Chr(32))
Dim i As Long, s As String
For i = LBound(v) To UBound(v) - 1
s = s & Chr(32) & v(i)
Next i
Dim rng As Range
Set rng = c.Parent
c.Delete
rng.AddComment Text:=s
rng.Comment.Shape.TextFrame.AutoSize = True
Next c
End Sub