Excel to Word Macro/Bookmark

Sethomas5

Board Regular
Joined
Oct 5, 2015
Messages
204
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:
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:
Code:
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
 
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.
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Forum statistics

Threads
1,225,767
Messages
6,186,907
Members
453,386
Latest member
testmaster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top