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.
New contributor
Shepherd darquea is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.