I'm trying to iterate through a list of values in excel to populate certain parts of a word document. The VBA script finds the strings listed in the arrays declared at the top ("revArrayY1", etc) and replaces that text with corresponding values in a spreadsheet using the .Cells function to grab the value. It worked at first, but when adding another row to the list of values in excel to populate, the .Cells function won't recognize the value in the new cell. All I did was shift the cells in excel up to make room for the new row and add a new string to the array.
Option Explicit
Sub ReplaceText()
Dim wApp As Object ' Change to "Object" for late binding
Dim wdoc As Object ' Change to "Object" for late binding
Dim custN As String, path As String
Dim revArrayY1 As Variant ' Declare as Variant for now
Dim revArrayY2 As Variant ' Declare as Variant for now
Dim revArrayY3 As Variant ' Declare as Variant for now
Dim revArrayY4 As Variant ' Declare as Variant for now
Dim revArrayY5 As Variant ' Declare as Variant for now
Dim COGArrayY1 As Variant ' Declare as Variant for now
Dim COGArrayY2 As Variant ' Declare as Variant for now
Dim COGArrayY3 As Variant ' Declare as Variant for now
Dim COGArrayY4 As Variant ' Declare as Variant for now
Dim COGArrayY5 As Variant ' Declare as Variant for now
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
' Initialize Excel objects
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("C:[file path]/ Financials.xlsx")
Set xlWS = xlWB.Sheets("Cashflow") ' Change "Cashflow" to your sheet name
' Sales Arrays
revArrayY1 = Array("<BeerSalesY1>", "<WineSalesY1>", "<SpiritSalesY1>", "<KDSalesY1>", "<BoochSalesY1>", "<VenueSalesY1>", "<KCSalesY1>", "<MealSalesY1>", "<RevFcstY1>")
revArrayY2 = Array("<BeerSalesY2>", "<WineSalesY2>", "<SpiritSalesY2>", "<KDSalesY2>", "<BoochSalesY2>", "<VenueSalesY2>", "<KCSalesY2>", "<MealSalesY2>", "<RevFcstY2>")
revArrayY3 = Array("<BeerSalesY3>", "<WineSalesY3>", "<SpiritSalesY3>", "<KDSalesY3>", "<BoochSalesY3>", "<VenueSalesY3>", "<KCSalesY3>", "<MealSalesY3>")
revArrayY4 = Array("<BeerSalesY4>", "<WineSalesY4>", "<SpiritSalesY4>", "<KDSalesY4>", "<BoochSalesY4>", "<VenueSalesY4>", "<KCSalesY4>", "<MealSalesY4>")
revArrayY5 = Array("<BeerSalesY5>", "<WineSalesY5>", "<SpiritSalesY5>", "<KDSalesY5>", "<BoochSalesY5>", "<VenueSalesY5>", "<KCSalesY5>", "<MealSalesY5>")
'COGS Arrays
COGArrayY1 = Array("<COGBeerY1>", "<COGWineY1>", "<COGSpiritY1>", "<COGKDY1>", "<COGBoochY1>", "<COGVenueY1>", "<COGKCY1>", "<COGMealY1>")
COGArrayY2 = Array("<COGBeerY2>", "<COGWineY2>", "<COGSpiritY2>", "<COGKDY2>", "<COGBoochY2>", "<COGVenueY2>", "<COGKCY2>", "<COGMealY2>")
COGArrayY3 = Array("<COGBeerY3>", "<COGWineY3>", "<COGSpiritY3>", "<COGKDY3>", "<COGBoochY3>", "<COGVenueY3>", "<COGKCY3>", "<COGMealY3>")
COGArrayY4 = Array("<COGBeerY4>", "<COGWineY4>", "<COGSpiritY4>", "<COGKDY4>", "<COGBoochY4>", "<COGVenueY4>", "<COGKCY4>", "<COGMealY4>")
COGArrayY5 = Array("<COGBeerY5>", "<COGWineY5>", "<COGSpiritY5>", "<COGKDY5>", "<COGBoochY5>", "<COGVenueY5>", "<COGKCY5>", "<COGMealY5>")
Dim i As Integer
Dim r As Long
r = 1
' Loop through rows of Excel worksheet
Do While r < 2
' Create new instance of Word application
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
' Open the Word document
Set wdoc = wApp.Documents.Open(Filename:="C:[file path]/Business Plan.dotx")
' Loop through Revenue Projections
' Loop through the array of strings
i = 0
For i = LBound(revArrayY1) To UBound(revArrayY1)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = revArrayY1(i)
Debug.Print xlWS.Cells(7 + i, 4).Value
.Replacement.Text = CStr(Round(xlWS.Cells(7 + i, 10).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(revArrayY2) To UBound(revArrayY2)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = revArrayY2(i)
.Replacement.Text = CStr(Round(xlWS.Cells(22 + i, 10).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(revArrayY3) To UBound(revArrayY3)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = revArrayY3(i)
.Replacement.Text = CStr(Round(xlWS.Cells(37 + i, 10).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(revArrayY4) To UBound(revArrayY4)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = revArrayY4(i)
.Replacement.Text = CStr(Round(xlWS.Cells(53 + i, 10).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(revArrayY5) To UBound(revArrayY5)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = revArrayY5(i)
.Replacement.Text = CStr(Round(xlWS.Cells(69 + i, 10).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
' Loop through COGS projections
i = 0
For i = LBound(COGArrayY1) To UBound(COGArrayY1)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = COGArrayY1(i)
.Replacement.Text = CStr(Round(xlWS.Cells(7 + i, 13).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(COGArrayY2) To UBound(COGArrayY2)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = COGArrayY2(i)
.Replacement.Text = CStr(Round(xlWS.Cells(22 + i, 13).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(COGArrayY3) To UBound(COGArrayY3)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = COGArrayY3(i)
.Replacement.Text = CStr(Round(xlWS.Cells(38 + i, 13).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(COGArrayY4) To UBound(COGArrayY4)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = COGArrayY4(i)
.Replacement.Text = CStr(Round(xlWS.Cells(54 + i, 13).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
i = 0
For i = LBound(COGArrayY5) To UBound(COGArrayY5)
' Find and replace text in Word document
With wdoc.Content.Find
.Text = COGArrayY5(i)
.Replacement.Text = CStr(Round(xlWS.Cells(70 + i, 13).Value / 1000, 0))
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
Next i
' Save the Word document
custN = xlWS.Cells(r, 1).Value
path = "C:[file path]\"
wdoc.SaveAs2 Filename:=path, FileFormat:=16, AddToRecentFiles:=False ' FileFormat 16 is wdFormatXMLDocument
' Close Word document
wdoc.Close
r = r + 1
Loop
' Close Excel workbook and application
xlWB.Close SaveChanges:=False
xlApp.Quit
' Release objects from memory
Set xlWS = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
Set wdoc = Nothing
Set wApp = Nothing
End Sub
I can print the index "i" and see that the FOR loop is iterating over the whole array and I have triple checked to make sure I am using the correct row and column numbers. I also put an arbitrary number into an arbitrary cell and just tried to print that cell and .Cells won't recognize that value either and it won't Debug.Print the value either. It seems like there came a point where it would only recognize the values in cells that I previously had. I thought maybe it was something wrong with the formatting of the cell, so I copied and pasted the value from a cell that is working and it still doesn't recognize the value. Furthermore, even though this doesn't throw an error in the first two for loops (it just doesn't work for the last couple values) when it gets to the FOR loop iterating over "revArrayY3" it throws a "Type Mismatch Error" even though all values are formatted the same and the FOR loops are identical.
Final code after getting a copy of your Excel file. Word-related parts are commented out, since I don't have the template document.
Sub ReplaceText()
Dim wApp As Object, wdoc As Object
Dim custN As String, path As String
Dim revArray As Variant, revArrayRows As Variant
Dim COGArray As Variant, COGArrayRows
Dim xlWB As Object, xlWS As Object
Dim i As Long, yr As Long, rw As Long, lbl As String, c As Range, v As String
'label Arrays
revArray = Array("BeerSales", "WineSales", "SpiritSales", "KDSales", _
"BoochSales", "VenueSales", "KCSales", "MealSales", "RevFcst")
COGArray = Array("COGBeer", "COGWine", "COGSpirit", "COGKD", "COGBooch", _
"COGVenue", "COGKC", "COGMeal", "COGFcst")
'Set xlWB = Workbooks.Open("C:\Users\sheph\Documents\Project Files\Fats Industries\Botanical Brews\Business Plan and Financials/Botanical Brews Financials.xlsx")
Set xlWS = ThisWorkbook.Worksheets("Cashflow") ' Change "Cashflow" to your sheet name
'Set wApp = CreateObject("Word.Application") ' Create new instance of Word application
'wApp.Visible = True
'Set wdoc = wApp.Documents.Open(Filename:="C:\Users\sheph\Documents\Project Files\Fats Industries\Botanical Brews\Business Plan and Financials/Botanical Brews Business Plan.dotx") ' Open the Word document
For yr = 1 To 5 'loop years 1-5
m = Application.Match("Year " & yr, xlWS.Columns("A"), 0) 'find the year on the data sheet
If Not IsError(m) Then 'got a match?
rw = m + 3 'data starts 3 rows down from year
Debug.Print "-------Year " & yr & ": Row# " & rw & " ------------"
Else
MsgBox "No 'Year " & yr & "' in ColA on data sheet", vbExclamation
Exit Sub
End If
For i = LBound(revArray) To UBound(revArray)
lbl = "<" & revArray(i) & "Y" & yr & ">"
Set c = xlWS.Cells(rw + i, "J")
v = CStr(Round(c.Value / 1000, 0))
'if you get a "type mismatch" error on the next line it's likely because `c` value is not numeric
Debug.Print "Got value '" & v & "' from " & c.Address(False, False) & " for " & lbl
'ReplaceAll wdoc, lbl, v
Next i
For i = LBound(COGArray) To UBound(COGArray)
lbl = "<" & COGArray(i) & "Y" & yr & ">"
Set c = xlWS.Cells(rw + i, "M")
v = CStr(Round(c.Value / 1000, 0))
Debug.Print "Got value '" & v & "' from " & c.Address(False, False) & " for " & lbl
'ReplaceAll wdoc, lbl, v
Next i
Next yr
'xlWB.Close SaveChanges:=False
' custN = xlWS.Cells(1, 1).Value ' Save the Word document
' path = "C:C:\Users\sheph\Documents\Project Files\Fats Industries\Botanical Brews\Business Plan and Financials\"
' wdoc.SaveAs2 Filename:=path, FileFormat:=16, AddToRecentFiles:=False ' 16 is wdFormatXMLDocument
' wdoc.Close
' wApp.Quit
End Sub
'In Word document `doc`, replace all instances of `findWhat` with `replaceWith`
Sub ReplaceAll(doc As Object, findWhat As String, replaceWith As String)
'Debug.Print "Replacing '" & findWhat & "' with '" & replaceWith & "'"
With doc.Content.Find
.Text = findWhat
.Replacement.Text = replaceWith
.Execute Replace:=2 ' wdReplaceAll constant value is 2
End With
End Sub