Extract row number using special.cells

xiaoying

New Member
Joined
Dec 6, 2019
Messages
26
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Put an IF test in maybe:

VBA Code:
For currentrow = 2 To lastRow
    If Not ws.Rows(currentrow).Hidden Then
        'code
    End If
Next
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,210
Members
453,023
Latest member
alabaz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top