Microsoft Office Forums - View Single Post - [Solved] Help with mail merge using DATABASE command with excel file.

Guessed · 06-02-2024, 04:58 PM

I would forget about doing this in Word and just stick with Excel and use a macro to build a series of worksheets per game.

I modified your Excel file by adding Table Formatting (aka List Objects) to the two input sheets and added a macro that builds the game lists.

Code:

Sub BuildGameRosters()
  Dim loDraw As ListObject, loRoster As ListObject
  Dim lrGame As ListRow, rngPlayer As Range
  Dim aWb As Workbook, aSht As Worksheet, i As Integer
  Dim sGame As String, sAwayTeam As String, sHomeTeam As String
  
  Set aWb = ActiveWorkbook
  Set loDraw = aWb.Sheets("TestRosterCardData").ListObjects(1)
  Set loRoster = aWb.Sheets("Rosters").ListObjects(1)
  
  'If the workbook contains more sheets than two, remove extras before recreating
  Application.DisplayAlerts = False
  Do While aWb.Sheets.Count > 2
    aWb.Sheets(aWb.Sheets.Count).Delete
  Loop
  
  For Each lrGame In loDraw.ListRows
    sGame = lrGame.Range.Cells(1, 1).Value
    sAwayTeam = lrGame.Range.Cells(1, 2).Value
    sHomeTeam = lrGame.Range.Cells(1, 3).Value
    
    Set aSht = aWb.Sheets.Add(After:=aWb.Worksheets(aWb.Worksheets.Count))
    aSht.Name = "Game " & sGame
    aSht.Cells(1, 1).Value = aSht.Name
    aSht.Cells(3, 1).Value = "Home Team"
    aSht.Cells(3, 2).Value = "Away Team"
    aSht.Cells(4, 1).Value = sHomeTeam
    aSht.Cells(4, 2).Value = sAwayTeam
    aSht.Range("A1:B4").Font.Bold = True
    
    loRoster.Range.AutoFilter Field:=1       'clear filter
    loRoster.Range.AutoFilter Field:=1, Criteria1:=sHomeTeam
    i = 0
    For Each rngPlayer In loRoster.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
      i = i + 1
      aSht.Cells(4, 1).Offset(i, 0) = rngPlayer.Cells(1, 2) & ", " & rngPlayer.Cells(1, 3)
    Next rngPlayer
    
    loRoster.Range.AutoFilter Field:=1       'clear filter
    loRoster.Range.AutoFilter Field:=1, Criteria1:=sAwayTeam
    i = 0
    For Each rngPlayer In loRoster.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
      i = i + 1
      aSht.Cells(4, 2).Offset(i, 0) = rngPlayer.Cells(1, 2) & ", " & rngPlayer.Cells(1, 3)
    Next rngPlayer
    aSht.Columns.AutoFit
    loRoster.Range.AutoFilter Field:=1       'clear filter
  Next lrGame
End Sub