[Excel/Word] Specific cells to Word Doc with formatting

[rfechner]

Hi All,

I need your help. I made a UserForm where one can select numbers based on a range of cells which will then be grabbed and placed into a word document in order to be printed. The user form has a starting and ending range or the option to select a single number.

See screen shot:


I've got the code to where it will open the word document and attempt to place some data, but it doesn't work correct. For instance, looking at the screen shot, if range LP 1 to LP 2 is selected, I want to place LP 1 in the word document and then Test A B C D. Also it would grab LP 2 and Test B C D.

The word document has some weird formatting due to using a template to print labels. I have attached word document I've been working with. Also, I wasn't able to attach the excel file, so here is a Dropbox link to it: https://www.dropbox.com/s/bb740ofaj4...Test.xlsm?dl=0

Here is the code I've come up with so far:

'Finding the Cell Address(es) of the selected LP #'s
'Looping through selected range of LP #'s

Dim LPcol As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'Change back to "Test Matrix" once imported

'Open an existing Word Document from Excel
Dim wdApp As Object, wdDoc As Object
Dim TestNum As String

Directory = Application.ActiveWorkbook.Path 'Directory of Test Matrix
Filename = "Test.doc" 'Filename of Word doc
        
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err.Number <> 0 Then 'Word isn't already running
        Set wdApp = CreateObject("Word.Application")
        End If
        On Error GoTo 0
        
        Set wdDoc = wdApp.Documents.Open(Directory & "\" & Filename) 'Opens existing word doc from directory with set filename
    
        wdApp.Visible = True
        wdDoc.Activate

ActiveSheet.Range("A4", ActiveSheet.Range("A1048576").End(xlUp)).Name = "LPcol"
Dim LP_temp As Integer
Dim LP1 As Range 'Starting LP #
Dim LP1_1 As Range 'Starting LP # if multiple tests
Dim LP2 As Range 'Ending LP #
Dim cell As Range

    With Sheets("Sheet1").Range("A:A")
        Set LP1 = ws.Range("LPcol").Find(LP_start.Value) 'Find the address of the Starting LP #, searching top down
    
            If LP_end.Value = "" Then 'If the Ending LP # is Empty Then..
                
                Set LP1_1 = ws.Range("LPcol").Find(What:=LP_start.Value, SearchDirection:=xlPrevious) 'Find the address of the Starting LP #, searching from bottom up if multiples exist
                
                If LP1.Address = LP1_1.Address Then 'If The Starting LP addresses are the same (ie. there aren't multiple tests for this LP) Then...
                'do nothing
                Else
                    
                    'For Each cell In Range(LP1, LP1_1) 'If there are multiple tests for the LP #, then loop through them
                    For i = LP1 To LP1_1
                    TestNum = (Cells(i, 5).Value)
                    wdApp.Selection.TypeText Text:=TestNum
                    wdApp.Selection.TypeParagraph
                    Next i
                    
                   
                    'Next cell
                End If
                
            Else
                Set LP2 = ws.Range("LPcol").Find(What:=LP_end.Value, SearchDirection:=xlPrevious) 'If the Ending LP # was selected, find the address, searching from bottom up
                    'For Each cell In Range(LP1, LP2) 'Loop through range of selected LP #s
                    'do whatever
                    'cell.Font.Color = vbRed
                    'Next cell
            End If
    End With

The main part I'm struggling with is what type of loop to use. I tried using a For Each cell in Range(LP1, LP2), but I wasn't sure how to increment rows to grab. Then I tried a for I = A to B, but excel didn't like that.

Thanks!