Word pulling data from Excel: For-Each loop on read input

**Phixer** · 06-09-2014, 02:31 PM

I have two documents: A Word document that will be dynamically generated (it will not exist before the macro is run), and an Excel spreadsheet containing the data that will need to be put into it. The macro is in a secondary Word document that will be accessed by multiple users with different computer configurations, so the code needs to remain simple (in terms of libraries and settings). MAIL MERGE CANNOT BE USED IN THIS INSTANCE so don't even suggest it, please.

I have had issues with Excel pushing the data into Word, so I am having Word pull the data into Excel with greater success, so this code is what is in Word, not Excel.

Sub PrepareFinancialStatement()
Dim Directory, FinancialStatementText, Month, FileName As String
Dim ItemInput, ItemValue As Variable

Directory = "U:\Reports\"
Month = "May" '(this will be converted into a dialog box later)
FinancialStatementText = "Financial Statement through " & StrConv(Month, vbLowerCase) & " 2014"

'Second Page comes from Briefing Document for Month and Year, Excel Worksheet
    
    ' Get Inputs for files required
    RowNum = 8
    Set AppExcel = CreateObject("Excel.Application")
    With AppExcel
                ExcelSheet = .getOpenFilename("Excel files (*.xls*),*.xls*", , "Select the Current Month Briefing Document")
    End With
    AppExcel.Workbooks.Open ExcelSheet
        
    ' Prepare Document with new Name
    ChangeFileOpenDirectory Directory
    Documents.Add DocumentType:=wdNewBlankDocument
    ActiveDocument.SaveAs2 FileName:=Directory & "Financial Statement " & Month & " 2014.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
    
    'Enter Text with Formatting into all Headers
    With ActiveDocument.Sections(1)
        .Headers(wdHeaderFooterPrimary).Range.Text = FinancialStatementText
        With .Headers(wdHeaderFooterPrimary).Range.Font
            .Name = "Cambria"
            .Size = 26
            .Bold = True
            .Italic = False
            .Underline = wdUnderlineNone
            .UnderlineColor = wdColorAutomatic
            .StrikeThrough = False
            .DoubleStrikeThrough = False
            .Outline = False
            .Emboss = False
            .Shadow = False
            .Hidden = False
            .SmallCaps = True
            .AllCaps = False
            .Color = wdColorAutomatic
            .Engrave = False
            .Superscript = False
            .Subscript = False
            .Spacing = 0
            .Scaling = 100
            .Position = 0
            .Kerning = 0
            .Animation = wdAnimationNone
            .Ligatures = wdLigaturesNone
            .NumberSpacing = wdNumberSpacingDefault
            .NumberForm = wdNumberFormDefault
            .StylisticSet = wdStylisticSetDefault
            .ContextualAlternates = 0
        End With
        .Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        With .Headers(wdHeaderFooterPrimary).Range.Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .Color = -553582695
        End With
    End With
    
    'Set Up Page Formatting (Borders and Such)
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(1.26)
        .BottomMargin = InchesToPoints(0.94)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.25)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
    
    'Set Up Paragaph Formatting
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LineSpacingRule = wdLineSpaceSingle
     End With
     
'First Page
    Selection.Font.Underline = True
    Selection.TypeText Text:="Below are the findings per the " & Month & " 2014 Trend Reports requiring Executive Staff attention:"
    Selection.Font.Underline = False
    Selection.InsertBreak Type:=wdPageBreak
    
' Program Budget Detail
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Font.Underline = True
    Selection.Font.Bold = True
    With Selection
        .TypeText Text:="Program Budget Detail"
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With
    Selection.Font.Bold = False
    Selection.Font.Underline = False
    Selection.TypeParagraph
    Selection.TypeParagraph
    
    
    Selection.Font.Underline = True
    Selection.Font.Bold = True
    With Selection
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .TypeText Text:="Office of the Secretary" & vbCr
    End With
    Selection.Font.Underline = False
    Selection.Font.Bold = False
    With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = ChrW(61623)
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = InchesToPoints(0.25)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = InchesToPoints(0.5)
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Name = "Symbol"
        End With
        .LinkedStyle = ""
    End With
    Selection.TypeText Text:="Total: "
    Call ApplyNumberFormatting(8, 10, AppExcel)
    Selection.TypeParagraph
    Selection.TypeText Text:="Unobligated Surplus: "
    Call ApplyNumberFormatting(8, 11, AppExcel)
    Selection.TypeText Text:=vbTab & vbTab & vbTab
    Selection.TypeText Text:="Unobligated Percentage: "
    Call ApplyPercentFormatting(8, 13, AppExcel)
    Selection.TypeText Text:=Chr(11)
    Selection.TypeParagraph
    Selection.TypeText Text:="Labor: "
    Call ApplyNumberFormatting(8, 3, AppExcel)
    Selection.TypeText Text:=" (Net Vacancies: "
    Call ApplyVacanciesFormatting(7, 2, AppExcel)
    Selection.TypeText Text:=")" & vbTab & vbTab & "Expenses: "
    Call ApplyNumberFormatting(8, 5, AppExcel)
    Selection.TypeText Text:=vbTab & vbTab & "Contractual Services: "
    Call ApplyNumberFormatting(8, 7, AppExcel)
    Selection.TypeParagraph
    Selection.TypeParagraph
    Call CFOStuff(X)
    Selection.TypeParagraph
    Selection.TypeParagraph

    Selection.Font.Underline = True
    Selection.Font.Bold = True
    With Selection
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .TypeText Text:="Assistant Secretary for Administration (ASA)" & vbCr
    End With
    Selection.Font.Underline = False
    Selection.Font.Bold = False
    With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = ChrW(61623)
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = InchesToPoints(0.25)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = InchesToPoints(0.5)
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Name = "Symbol"
        End With
        .LinkedStyle = ""
    End With
    Selection.TypeText Text:="Total: "
    Call ApplyNumberFormatting(9, 10, AppExcel)
    Selection.TypeParagraph
    Selection.TypeText Text:="Unobligated Surplus: "
    Call ApplyNumberFormatting(9, 11, AppExcel)
    Selection.TypeText Text:=vbTab & vbTab & vbTab
    Selection.TypeText Text:="Unobligated Percentage: "
    Call ApplyPercentFormatting(9, 13, AppExcel)
    Selection.TypeText Text:=Chr(11)
    Selection.TypeParagraph
    Selection.TypeText Text:="Labor: "
    Call ApplyNumberFormatting(9, 3, AppExcel)
    Selection.TypeText Text:=" (Net Vacancies: "
    Call ApplyVacanciesFormatting(9, 2, AppExcel)
    Selection.TypeText Text:=")" & vbTab & vbTab & "Expenses: "
    Call ApplyNumberFormatting(9, 5, AppExcel)
    Selection.TypeText Text:=vbTab & vbTab & "Contractual Services: "
    Call ApplyNumberFormatting(9, 7, AppExcel)
    Selection.TypeParagraph
    Selection.TypeParagraph
    Call CFOStuff(X)
    Selection.TypeParagraph
    Selection.TypeParagraph

    ' Apply All Formatting to Document
    ActiveDocument.Paragraphs(3).Range.InlineShapes.AddHorizontalLineStandard
    ActiveDocument.Paragraphs(7).Range.InlineShapes.AddHorizontalLineStandard
    ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(9).Range.Start, End:=ActiveDocument.Paragraphs(11).Range.End).ListFormat.ApplyListTemplateWithLevel ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
    ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(14).Range.Start, End:=ActiveDocument.Paragraphs(16).Range.End).ListFormat.ApplyListTemplateWithLevel ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(2), ContinuePreviousList:=True, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
    ActiveDocument.Paragraphs(18).Range.InlineShapes.AddHorizontalLineStandard
        
End Sub

Sub ApplyNumberFormatting(X, Y, AppExcel)
Dim NumberText As String
Dim Num As Integer
Dim Negative As Boolean
Negative = False

    Selection.Font.Bold = True
    NumberText = AppExcel.Worksheets("Grouping with Activity-Included").Cells(X, Y).Value
    NumberText = Str(Int(Val(NumberText) + 0.5))
    NumberText = Replace(NumberText, " ", "")
    Num = Len(NumberText)
    If Left(NumberText, 1) = "-" Then
        NumberText = Right(NumberText, Num - 1)
        Num = Num - 1
        Negative = True
    End If
    Select Case Int((Num - 1) / 3)
        Case 1
            NumberText = Left(NumberText, Num - 3) & "," & Right(NumberText, 3)
        Case Is > 1
            For X = 1 To Int((Num - 1) / 3)
                NumberText = Left(NumberText, Num - 3 * X) & "," & Right(NumberText, 2 + (X - 1) * 3 + X)
            Next X
    End Select
    If Negative = True Then
        Selection.Font.ColorIndex = wdRed
        Selection.TypeText Text:="$ (" & NumberText & ")"
    Else
        Selection.Font.ColorIndex = wdAuto
        Selection.TypeText Text:="$ " & NumberText
    End If
    Selection.Font.ColorIndex = wdAuto
    Selection.Font.Bold = False
        
End Sub

Sub ApplyPercentFormatting(X, Y, AppExcel)
Dim NumberText As String
Dim Num As Integer
Dim Negative As Boolean
Negative = False

    Selection.Font.Bold = True
    NumberText = AppExcel.Worksheets("Grouping with Activity-Included").Cells(X, Y).Value
    NumberText = Str(Int(Val(NumberText) * 10000 + 0.5) / 100)
    Num = Len(NumberText)
    If Left(NumberText, 1) = "-" Then
        NumberText = Right(NumberText, Num - 1)
        Num = Num - 1
        Negative = True
    End If
    If Negative = True Then
        Selection.Font.ColorIndex = wdRed
        Selection.TypeText Text:="(" & NumberText & "%)"
    Else
        Selection.Font.ColorIndex = wdAuto
        Selection.TypeText Text:=NumberText & "%"
    End If
    Selection.Font.ColorIndex = wdAuto
    Selection.Font.Bold = False

End Sub

Sub ApplyVacanciesFormatting(X, Y, AppExcel)
Dim NumberText As String
Dim Num As Integer
Dim Negative As Boolean
Negative = False

    Selection.Font.Bold = True
    NumberText = AppExcel.Worksheets("FTE Info").Cells(X, Y).Value
    NumberText = Str(Int(Val(NumberText) * 100 + 0.5))
    Num = Len(NumberText)
    NumberText = Left(NumberText, Num - 2) & "." & Right(NumberText, 2)
    If Left(NumberText, 1) = "-" Then
        NumberText = Right(NumberText, Num - 1)
        Num = Num - 1
        Negative = True
    End If
    If Negative = True Then
        Selection.Font.ColorIndex = wdRed
        Selection.TypeText Text:="(" & NumberText & ")"
    Else
        Selection.Font.ColorIndex = wdAuto
        Selection.TypeText Text:=NumberText
    End If
    Selection.Font.ColorIndex = wdAuto
    Selection.Font.Bold = False

End Sub

Sub CFOStuff(X)
    Selection.Font.Bold = True
    Selection.Font.Underline = wdUnderlineSingle
    Selection.Paragraphs.LeftIndent = 36
    Selection.TypeText Text:="CFO POINT OF VIEW:"
    Selection.Font.Underline = False
    Selection.TypeText Text:=vbCr & "Labor -"
    Selection.TypeText Text:=vbCr & "Expenses -"
    Selection.TypeText Text:=vbCr & "Contractual Services -" & vbCr
    Selection.Font.Bold = False
    Selection.Paragraphs.LeftIndent = 0

End Sub

Right now, it works, but it will take hundreds of lines of code to finish it.

After writing the above, it occurs to me that the Worksheet "Grouping with Activity-Included" has all the entries I need to break out in its first column, so if I can write a For-Each specifying that column, and enter in the values pulled from its corresponding column to the right, the code can be much shorter.

Actual Question:Can someone give me an idea on how to write this For-Each that looks into Excel to find out how many times to iterate?

Thanks!