Problem using Offset in an IF statement (VBA)

[Kregg]

Hi and thanks in advance for any help.

I am using the following code to automate a mail merge through excel at the click of a button.

Option Explicit
'change this to where your files are stored
Const FilePath As String = "C:\Users\chowell\Desktop\"
Dim wd As New Word.Application
Dim PersonCell As Range

Sub CreateWordDocuments()
'create copy of Word in memory
Dim doc As Word.Document
Dim Cell As Range
Set wd = New Word.Application
wd.Visible = True
Dim PersonRange As Range
'create a reference to all the people
Range("B3").Select
Set PersonRange = Range(ActiveCell, ActiveCell.End(xlDown))
'for each person in list �
For Each PersonCell In PersonRange
If PersonCell.Offest(0, 4).Value = "" Then
'open a document in Word
Set doc = wd.Documents.Open(FilePath & "Follow Up Letter.dotx")
'go to each bookmark and type in details
CopyCell "FirstName", 1
CopyCell "LastName", 0
CopyCell "Street", 6
CopyCell "City", 7
CopyCell "State", 8
CopyCell "Zip", 9
'save and close this document

doc.ExportAsFixedFormat OutputFileName:=FilePath & PersonCell.Value & ", " & PersonCell.Offset(0, 1) & ".PDF", _
    ExportFormat:=wdExportFormatPDF
doc.Close False
Else
End If
Next PersonCell
wd.Quit
Set wd = Nothing
MsgBox "Created files in " & FilePath & "!"
End Sub

Sub CopyCell(BookMarkName As String, ColumnOffset As Integer)
'copy each cell to relevant Word bookmark
wd.Selection.GoTo What:=wdGoToBookmark, Name:=BookMarkName
wd.Selection.TypeText PersonCell.Offset(0, ColumnOffset).Value
End Sub

If I take the IF statement out this code will save letters for everyone in the list, however I only want a letter to save if the offset value = ""

Any help would be greatly appreciated!

 

[Kregg]

I rewrote the code to make this work. It is not very efficient as it uses "Select" Method a lot but it does the trick.

Sub Mailmerge()
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim mywdRange As Word.Range
Dim sh As Worksheet
Dim Cell As Range
Dim xFirstName As Excel.Range
Dim xLastName As Excel.Range
Dim xStreet As Excel.Range
Dim xCity As Excel.Range
Dim xState As Excel.Range
Dim xZip As Excel.Range
Set wdApp = New Word.Application
With wdApp
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set sh = Sheets("Sheet1")
Range("B2").Select
For Each Cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
Else
If ActiveCell.Value > 0 Then
If ActiveCell.Offset(0, 4) = "" Then
Set myDoc = wdApp.Documents.Add(Template:="C:\Users\chowell\Desktop\Follow Up Letter.dotx")
With ActiveCell
    Range(Cells(.Row, "C"), Cells(.Row, "C")).Select
    Set xFirstName = ActiveCell
    Range(Cells(.Row, "B"), Cells(.Row, "B")).Select
    Set xLastName = ActiveCell
    Range(Cells(.Row, "H"), Cells(.Row, "H")).Select
    Set xStreet = ActiveCell
    Range(Cells(.Row, "I"), Cells(.Row, "I")).Select
    Set xCity = ActiveCell
    Range(Cells(.Row, "J"), Cells(.Row, "J")).Select
    Set xState = ActiveCell
    Range(Cells(.Row, "K"), Cells(.Row, "K")).Select
    Set xZip = ActiveCell
    Range(Cells(.Row, "N"), Cells(.Row, "N")).Value = Date
    Range(Cells(.Row, "B"), Cells(.Row, "B")).Select
End With
With myDoc.Bookmarks
.Item("FirstName").Range.InsertAfter xFirstName
.Item("LastName").Range.InsertAfter xLastName
.Item("Street").Range.InsertAfter xStreet
.Item("City").Range.InsertAfter xCity
.Item("State").Range.InsertAfter xState
.Item("Zip").Range.InsertAfter xZip
End With
myDoc.PrintOut
myDoc.Close False
End If
End If
End If
Next Cell

 

[Kregg]

I can't find the solved button to mark this thread as solved but it is now in fact SOLVED