I am having difficulty extracting filtered cell values to replace the details in Microsoft Word for my automation of letters. For example, I want to exclude one of the company from my rows by using filter on my "company name" row. Thus when I run the code, that company that I have excluded will not have its details automated into Microsoft Word. Is there any way to use special.cells to edit this part For currentRow = 2 To lastRow so that it will only extract the filtered data?
VBA Code:
Option Explicit
Public Sub WordFindAndReplaceSave()
Dim ws As Worksheet, msWord As Object
Dim currentRow As Long
Dim rowCount As Long
Dim lastRow As Long
Dim filename As String
Dim Path1 As String
Dim myD2Range As Range
Dim myE2Range As Range
Dim myF2Range As Range
Dim myG2Range As Range
Dim myRange As Range
Path1 = "C:\Users\xlim\Desktop\Edited Letters"
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
For currentRow = 2 To lastRow
filename = ws.Range("C" & currentRow).Value
Set myD2Range = ws.Range("D" & currentRow)
Set myE2Range = ws.Range("E" & currentRow)
Set myF2Range = ws.Range("F" & currentRow)
Set myG2Range = ws.Range("G" & currentRow)
Set myRange = ws.Range("D" & currentRow & ":" & "G" & currentRow)
With msWord
.Visible = True
.Documents.Open "C:\Users\xlim\Desktop\Engagement letter - STC.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "DELVIN WONG WERN LIAT"
.Replacement.Text = ws.Range("A" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "THE BOARD OF DIRECTORS"
.Replacement.Text = ws.Range("B" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "KOOLOOK PTE. LTD."
.Replacement.Text = ws.Range("C" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
If WorksheetFunction.CountA(myD2Range) < myD2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myE2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myE2Range) < myE2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myF2Range) < myF2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myG2Range) < myG2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myRange) = myRange.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End If
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "24 MAY 2019"
.Replacement.Text = ws.Range("H" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "KPL/OAA/GTO/BK/AL"
.Replacement.Text = ws.Range("I" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
msWord.ActiveDocument.SaveAs filename:=Path1 & "/" & "Engagement Letter - " & filename & ".docx"
msWord.ActiveDocument.Close
rowCount = rowCount + 1
End With
Next currentRow
End Sub
