# Excel to Word Macro/Bookmark



## Sethomas5 (Apr 20, 2016)

Thanks in advance for your help!
I want this code to look or a column header, and if it is not there, take information from another worksheet (not active) and put it in the bookmark in word.
Code:

```
Case "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    Case Is <> "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells("'Core Category'!I3") & "(" & ("CIS 212/INF 104") & ws.Cells("'Core Category'!I10") & ("CIS 212/INF 104/TEC 161") & ")"
                        Exit For
                           
                        
                    Next i
```

Entire macro included if needed:

```
Sub SendToWord()
Dim objWord As Object
Dim objDoc As Object
Dim ws As Worksheet


    Set objWord = CreateObject("Word.Application")
    
    objWord.Visible = True

    For Each ws In ActiveWorkbook.Worksheets
        
        
        If ws.Name <> "equivalents" And ws.Name <> "Core Category" And ws.Name <> "Sheet4" Then ' dont open equivalents and Core Category

            ' create new document based on template
            Set objDoc = objWord.Documents.Add("C:\Users\thomassa\Desktop\excel project\trythistemplatenow.dotm")      ' change as required

            With objDoc

                .Bookmarks("EKU_Major").Range.Text = ws.Name ' puts wksht name as the major
             For k = 9 To 17
                Select Case ws.Cells(1, k).Value
                Case "Written Communication"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Writing_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Writing_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                            
                Case "Oral Communication"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Oral_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Oral_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Oral_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                 
                Case "Natural Sciences"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Science_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Foreign Languages"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Foreign_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Heritage"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Heritage_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Humanities"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Humanities_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Social & Behavioral Sciences"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Social_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class6").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class7").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                
                Case "Quantitative Reasoning"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    
                    Case "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    Case Is <> "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells("'Core Category'!I3") & "(" & ("CIS 212/INF 104") & ws.Cells("'Core Category'!I10") & ("CIS 212/INF 104/TEC 161") & ")"
                        Exit For
                           
                        
                    Next i
                    
                End Select
            Next k


                .SaveAs ThisWorkbook.Path & "\" & "KCTCS Curriculum Planners" & "\" & "AA Curriculum Planners" & "\" & ws.Name & ".docx"

                .Close

            End With

            Set objDoc = Nothing
        End If

    Next ws

    objWord.Quit

    Set objWord = Nothing

End Sub
```


----------



## Sethomas5 (Apr 20, 2016)

Any information would be helpful.


----------



## Macropod (Apr 21, 2016)

Presumably, your line:
Case Is <> "Computer Literacy"
should just be:
Case Else

The 'For ... Next' loop following:
Case Is <> "Computer Literacy"
is illogical, as it exits via the 'Exit For' without ever completing a single pass. You may as well skip the loop altogether and just have:
.Bookmarks("Computer_Class1").Range.Text = ws.Cells("'Core Category'!I3") & "(" & ("CIS 212/INF 104") & ws.Cells("'Core Category'!I10") & ("CIS 212/INF 104/TEC 161") & ")"
But even that line is bizarre, as 'ws.Cells("'Core Category'!I3")' and 'ws.Cells("'Core Category'!I10")' are nonsense. Presumably you meant to have Worksheets("Core Category").Range("I3") and Worksheets("Core Category").Range("I10") but, since you nowhere say exactly what it is you want, I'm just guessing.


----------



## Sethomas5 (Apr 21, 2016)

Macropod said:


> Presumably, your line:
> Case Is <> "Computer Literacy"
> should just be:
> Case Else
> ...



Thanks for the reply.
I am trying to have this code look for a column header (Computer Literacy) in an active worksheet and if it is there, fill in the appropriate information in the bookmark I have made on a word template. If the header is not in the active worksheet I want the code to go to the Core Category worksheet, go to the column header labeled Computer Literacy and put the appropriate information in the bookmark.
Hoping that makes sense.

If your suggestion would get me to that point please let me know.


----------



## Macropod (Apr 21, 2016)

Well, you code only ever looks at row 1 of columns 9 to 17 and never explicitly tests whether 'Computer Literacy' exists in that range; all it does is populate a 'str1' variable that is never defined or used and a Word bookmark that corresponds with whatever is defined by the Select Case statement, populated from any row in the column concerned. If you to do something different if 'Computer Literacy' doesn't exist in that range, you need to actually test for its presence. For example:

```
Dim bComp as Boolean
...
           With objDoc
                bComp = False
                .Bookmarks("EKU_Major").Range.Text = ws.Name ' puts wksht name as the major
                For k = 9 To 17
...
                    Case "Computer Literacy"
                        bComp = True
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                Next k
                If bComp = False Then
                    .Bookmarks("Computer_Class1").Range.Text = Worksheets("Core Category").Range("I3")  & "(" & ("CIS 212/INF 104") & Worksheets("Core Category").Range("I10") & ("CIS 212/INF 104/TEC 161") & ")"
                End If
```


----------



## Sethomas5 (Apr 22, 2016)

Macropod said:


> Well, you code only ever looks at row 1 of columns 9 to 17 and never explicitly tests whether 'Computer Literacy' exists in that range; all it does is populate a 'str1' variable that is never defined or used and a Word bookmark that corresponds with whatever is defined by the Select Case statement, populated from any row in the column concerned. If you to do something different if 'Computer Literacy' doesn't exist in that range, you need to actually test for its presence. For example:
> 
> ```
> Dim bComp as Boolean
> ...



Okay, thank you. Would I be able to add this in with the current macro, or would I need to run this separately?


----------



## Macropod (Apr 22, 2016)

Sethomas5 said:


> Okay, thank you. Would I be able to add this in with the current macro, or would I need to run this separately?


Those are all modifications of your existing macro; there isn't enough code for them to run on their own.


----------



## Sethomas5 (Apr 28, 2016)

Macropod said:


> Those are all modifications of your existing macro; there isn't enough code for them to run on their own.



Okay, sorry I am just extremely new at this at have no idea what I'm doing. Could you possible show me where I would put this code?

Thanks.


----------



## Macropod (Apr 28, 2016)

Try the following. The substantive changes are bolded. I've also tidied up your code structure.

```
Sub SendToWord()
Dim objWord As Object, objDoc As Object, ws As Worksheet, [B]bComp As Boolean[/B]
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
For Each ws In ActiveWorkbook.Worksheets
    ' dont open equivalents and Core Category
    If ws.Name <> "equivalents" And ws.Name <> "Core Category" And ws.Name <> "Sheet4" Then
        ' create new document based on template - change as required
        Set objDoc = objWord.Documents.Add("C:\Users\" [B]& Environ("UserName") &[/B] _
            "\Desktop\excel project\trythistemplatenow.dotm")
        With objDoc
            [B]bComp = False[/B]
            .Bookmarks("EKU_Major").Range.Text = ws.Name ' puts wksht name as the major
            For k = 9 To 17
                Select Case ws.Cells(1, k).Value
                Case "Written Communication"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Writing_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Writing_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Oral Communication"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Oral_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Oral_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Oral_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Natural Sciences"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Science_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Science_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Science_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Science_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Foreign Languages"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Foreign_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Foreign_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Foreign_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Foreign_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Heritage"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Heritage_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Heritage_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Heritage_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Heritage_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Heritage_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Humanities"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Humanities_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Humanities_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Humanities_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Humanities_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Humanities_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Social & Behavioral Sciences"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class6").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Social_Class7").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                Case "Quantitative Reasoning"
                    For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Quantitative_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Quantitative_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                        If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                            .Bookmarks("Quantitative_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                            Exit For
                        End If
                    Next i
                    Case "Computer Literacy"
                        [B]bComp = True[/B]
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                                str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                                Exit For
                            End If
                    Next i
                    [B]If bComp = False Then
                        .Bookmarks("Computer_Class1").Range.Text = _
                            Worksheets("Core Category").Range("I3") & " (CIS 212/INF 104) " & _
                            Worksheets("Core Category").Range("I10") & " (CIS 212/INF 104/TEC 161)"
                    End If[/B]
                End Select
            Next k
            .SaveAs ThisWorkbook.Path & "\KCTCS Curriculum Planners\AA Curriculum Planners\" & ws.Name & ".docx"
            .Close
        End With
        Set objDoc = Nothing
    End If
Next ws
objWord.Quit
Set objWord = Nothing
End Sub
```


----------



## Sethomas5 (Apr 29, 2016)

Macropod said:


> Try the following. The substantive changes are bolded. I've also tidied up your code structure.
> 
> ```
> Sub SendToWord()
> ...



Thank you so much for helping out!
However, that didn't put anything into the bookmark :/


----------



## Sethomas5 (Apr 20, 2016)

Thanks in advance for your help!
I want this code to look or a column header, and if it is not there, take information from another worksheet (not active) and put it in the bookmark in word.
Code:

```
Case "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    Case Is <> "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells("'Core Category'!I3") & "(" & ("CIS 212/INF 104") & ws.Cells("'Core Category'!I10") & ("CIS 212/INF 104/TEC 161") & ")"
                        Exit For
                           
                        
                    Next i
```

Entire macro included if needed:

```
Sub SendToWord()
Dim objWord As Object
Dim objDoc As Object
Dim ws As Worksheet


    Set objWord = CreateObject("Word.Application")
    
    objWord.Visible = True

    For Each ws In ActiveWorkbook.Worksheets
        
        
        If ws.Name <> "equivalents" And ws.Name <> "Core Category" And ws.Name <> "Sheet4" Then ' dont open equivalents and Core Category

            ' create new document based on template
            Set objDoc = objWord.Documents.Add("C:\Users\thomassa\Desktop\excel project\trythistemplatenow.dotm")      ' change as required

            With objDoc

                .Bookmarks("EKU_Major").Range.Text = ws.Name ' puts wksht name as the major
             For k = 9 To 17
                Select Case ws.Cells(1, k).Value
                Case "Written Communication"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Writing_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Writing_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                            
                Case "Oral Communication"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Oral_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Oral_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Oral_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                 
                Case "Natural Sciences"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Science_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Science_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Foreign Languages"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Foreign_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Foreign_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Heritage"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Heritage_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Heritage_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Humanities"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Humanities_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Humanities_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                
                Case "Social & Behavioral Sciences"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                             .Bookmarks("Social_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                 Next i
                         For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                         Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class4").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class5").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class6").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                             If ws.Cells(i, k) <> "" Then
                             str1 = ws.Cells(i, k)
                                .Bookmarks("Social_Class7").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                Next i
                
                Case "Quantitative Reasoning"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class2").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                        For i = i + 1 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = ws.Cells(i, k)
                                .Bookmarks("Quantitative_Class3").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    
                    Case "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                            If ws.Cells(i, k) <> "" Then
                            str1 = Cells(i, k)
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells(i, k) & "(" & ws.Cells(i, "G") & ")"
                        Exit For
                            End If
                    Next i
                    Case Is <> "Computer Literacy"
                        For i = 2 To ws.Cells(Rows.Count, k).End(xlUp).Row
                                .Bookmarks("Computer_Class1").Range.Text = ws.Cells("'Core Category'!I3") & "(" & ("CIS 212/INF 104") & ws.Cells("'Core Category'!I10") & ("CIS 212/INF 104/TEC 161") & ")"
                        Exit For
                           
                        
                    Next i
                    
                End Select
            Next k


                .SaveAs ThisWorkbook.Path & "\" & "KCTCS Curriculum Planners" & "\" & "AA Curriculum Planners" & "\" & ws.Name & ".docx"

                .Close

            End With

            Set objDoc = Nothing
        End If

    Next ws

    objWord.Quit

    Set objWord = Nothing

End Sub
```


----------



## Macropod (May 6, 2016)

In that case, you need to explain exactly what determines when the bookmark should be updated and what it should be updated with. The code you posted for anyone to work with was almost unintelligible.


----------

