Referencing rows of a table at a bookmarked location based on the value of a column

jpb103 · #1 05-21-2014, 06:16 AM

I have a table in word that has a column which contains a drop down list for priority (the choices are Low, Medium, High). I have a bookmarked section of the same document that I would like to show all rows of this table that are designated high priority. Can this be acheived with a macro by using tables in word? Would this be made simpler by inserting an excel worksheet object instead?

gmaxey · #2 05-21-2014, 07:31 AM

Assumes the column containing the Low, Med, High is column 2:

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim oCol As New Collection
Dim lngIndex As Long
Dim oRng As Word.Range
Dim oRow As Row
Dim lngCell As Long
  Set oTbl = ActiveDocument.Tables(1)
  For Each oRow In oTbl.Rows
    If Left(oRow.Cells(2).Range.Text, Len(oRow.Cells(2).Range.Text) - 2) = "High" Then
      oCol.Add oRow
    End If
  Next oRow
  Set oRng = ActiveDocument.Bookmarks("bmRows").Range
  If oRng.Tables.Count = 1 Then
    oRng.Tables(1).Delete
  End If
  Set oTbl = oRng.Tables.Add(oRng, oCol.Count, 3)
  For lngIndex = 1 To oCol.Count
    For lngCell = 1 To oCol(lngIndex).Range.Cells.Count
      oTbl.Rows(lngIndex).Cells(lngCell).Range.Text = Left(oCol(lngIndex).Cells(lngCell).Range.Text, _
          Len(oCol(lngIndex).Cells(lngCell).Range.Text) - 2)
    Next
  Next
  ActiveDocument.Bookmarks.Add "bmRows", oTbl.Range
End Sub

jpb103 · #3 05-21-2014, 07:58 AM

This will help me for sure. Thanks pal!
I now have another problem though; I created a user form for the user to enter new items into the original table and I'm having problems loading the form data into the cells of a row object.

Code:

Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub OKButton_Click()
'Error handling for empty boxes
Dim msg, msg2, msg3 As String
msg = "You must enter a Description"
msg2 = "You must enter a Date"
msg3 = "You must enter a Priority"
If (DescriptionBox = "") Then
    MsgBox (msg)
ElseIf (DateBox = "") Then
    MsgBox (msg2)
ElseIf (PriorityCombo = "") Then
    MsgBox (msg3)
Else
    'No errors detected, add row to table and populate
    Dim oTbl As Word.Table
    Dim oRow As Row
    Dim oCol As Column
    Dim oRng As Word.Range
    Dim lngIndex As Long
    Dim lngCell As Long
    Set oTbl = ActiveDocument.Tables(1)
    oRow.Cells(0).Range.Text = DescriptionBox.Text
    oRow.Cells(1).Range.Text = DateBox.Text
    oRow.Cells(2).Range.Text = PriorityCombo.Text
    oRow.Cells(3).Range.Text = ActiveDocument.Tables(1).Rows(0).Cells(3).Range.Text
    ActiveDocument.Tables(1).Rows.Add oRow
    Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
PriorityCombo.Clear
PriorityCombo.AddItem "Low"
PriorityCombo.AddItem "Medium"
PriorityCombo.AddItem "High"
End Sub

gmaxey · #4 05-21-2014, 09:44 AM

On second thought this might be better. This way you can use non-uniform tables:

Code:

Sub ScratchMacro()
Dim oTbl As Word.Table, oTblTarget As Table
Dim arrIndex() As Long
Dim lngIndex As Long
Dim oRng As Word.Range
  Set oTbl = ActiveDocument.Tables(1)
  oTbl.Range.Copy
  Set oRng = ActiveDocument.Bookmarks("bmRows").Range
  If oRng.Tables.Count = 1 Then
    oRng.Tables(1).Delete
  End If
  oRng.Paste
  Set oTblTarget = oRng.Tables(1)
  ActiveDocument.Bookmarks.Add "bmRows", oTblTarget.Range
  ReDim arrIndex(0)
  For lngIndex = oTbl.Rows.Count To 1 Step -1
    If Not Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2) = "High" Then
      arrIndex(UBound(arrIndex)) = oTbl.Rows(lngIndex).Index
      ReDim Preserve arrIndex(UBound(arrIndex) + 1)
    End If
  Next lngIndex
  For lngIndex = 0 To UBound(arrIndex) - 1
    oTblTarget.Rows(arrIndex(lngIndex)).Delete
  Next lngIndex
End Sub

gmaxey · #5 05-21-2014, 09:55 AM

Code:

Private Sub OKButton_Click()
Dim oTbl As Word.Table
Dim oRow As Row
Dim oRng As Word.Range
  Select Case True
    Case DescriptionBox = vbNullString
      MsgBox "You must enter a description"
    Case Not IsDate(DateBox)
      MsgBox "You must enter a valid date."
    Case PriorityCombo = vbNullString
      MsgBox "You must select the priority."
    Case Else
      Set oTbl = ActiveDocument.Tables(1)
      Set oRow = oTbl.Rows.Add
      oRow.Cells(1).Range.Text = DescriptionBox.Text
      oRow.Cells(2).Range.Text = DateBox.Text
      oRow.Cells(3).Range.Text = PriorityCombo.Text
      Unload Me
  End Select
End Sub

jpb103 · #6 05-21-2014, 10:23 AM

Thanks again, I've been gradually working through it and I'm making progress.

gmaxey · #7 05-21-2014, 10:33 AM

If you experience is anything like mine often is then you are sitting surrounded by clumps of hair and bloody scalp. Gook luck.

jpb103 · #8 05-21-2014, 11:30 AM

Haha, yeah..you're not programming until you want to set fire to your office.

My code is looking a lot like the last block of code you submitted. The problem I'm struggling with now is that the fourth cell in the new row should contain an ActiveX CheckBox object, but I'm having trouble finding a way to insert it.

gmaxey · #9 05-21-2014, 01:21 PM

Code:

  oRow.Range.Cells(4).Range.InlineShapes.AddOLEControl ClassType:="Forms.CheckBox.1"

jpb103 · #10 05-22-2014, 07:21 AM

Thanks Greg, that worked great! I don't suppose you would know how to create the checkbox with no caption (or change it to "" after the fact)?

gmaxey · #11 05-22-2014, 08:20 AM

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRow As Row
Dim oCtr As InlineShape
Set oRow = ActiveDocument.Tables(1).Rows.Last
Set oCtr = oRow.Range.Cells(4).Range.InlineShapes.AddOLEControl(ClassType:="Forms.CheckBox.1")
oCtr.OLEFormat.Object.Caption = ""
End Sub

jpb103 · #12 05-22-2014, 08:33 AM

Thanks again Greg! That resolves all my problems relevant to this thread.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Mouseover cell to indicate mouse pointer location based on Specific Row/Column values	bolandk	Excel	1	05-15-2014 08:22 AM
Group Table Rows/Column (like Excel Group)	eoinymc	Word	1	03-11-2014 04:51 AM
Need help on duplicates in column; deciding which to keep based on other column	nwcf	Excel	3	01-31-2014 09:43 AM
Grouping table rows to prevent individual rows from breaking across pages	dennist77	Word	1	10-29-2013 11:39 PM
Referencing a Image File and Location	matt8445	PowerPoint	2	11-08-2012 08:23 AM