Dim objExcel As Excel.Application, xlWB As Workbook, xlWS As Worksheet
Dim strCenter As String, strLName As String, strFName As String, strAdd1 As String
Dim strAdd2 As String, strCity As String, strState As String, strZip As String
Dim strPhone As String, strEmail As String, intCount As Integer, intRow As Integer
Dim strAddress As String, strAddress1 As String, strRole As String
Dim strFax As String
Set objExcel = New Excel.Application
Set xlWB = objExcel.Workbooks.Add
Set xlWS = xlWB.Worksheets.Application.ActiveSheet
With xlWS
.Range("A1").Value = "Health Center Name"
.Range("A1").Cells.Font.Bold = True
.Range("B1").Value = "Last Name"
.Range("B1").Cells.Font.Bold = True
.Range("C1").Value = "First Name"
.Range("C1").Cells.Font.Bold = True
.Range("D1").Value = "Role"
.Range("D1").Cells.Font.Bold = True
.Range("E1").Value = "Address1"
.Range("E1").Cells.Font.Bold = True
.Range("F1").Value = "Address2"
.Range("F1").Cells.Font.Bold = True
.Range("G1").Value = "City"
.Range("G1").Cells.Font.Bold = True
.Range("H1").Value = "State"
.Range("H1").Cells.Font.Bold = True
.Range("I1").Value = "Zip Code"
.Range("I1").Cells.Font.Bold = True
.Range("J1").Value = "Phone"
.Range("J1").Cells.Font.Bold = True
.Range("K1").Value = "Email"
.Range("K1").Cells.Font.Bold = True
.Range("L1").Value = "FAX"
.Range("L1").Cells.Font.Bold = True
.Range("A1:L1").HorizontalAlignment = xlCenter
.Range("A2").Select
End With
intCount = 1
intRow = 2
intPosition = 1
intPosition2 = 1
Do Until intCount = Me.lstSiteContacts.ListCount
strLName = Me.lstSiteContacts.Column(0, (intRow - 1))
strFName = Me.lstSiteContacts.Column(1, (intRow - 1))
strRole = Me.lstSiteContacts.Column(2, (intRow - 1))
strAddress1 = Me.lstSiteContacts.Column(3, (intRow - 1))
strAddress2 = Me.lstSiteContacts.Column(4, (intRow - 1))
strCity = Me.lstSiteContacts.Column(5, (intRow - 1))
strState = Me.lstSiteContacts.Column(6, (intRow - 1))
strZip = Me.lstSiteContacts.Column(7, (intRow - 1))
strPhone = Me.lstSiteContacts.Column(8, (intRow - 1))
strEmail = Me.lstSiteContacts.Column(9, (intRow - 1))
strFax = Me.lstSiteContacts.Column(10, (intRow - 1))
' copies the Center Name
With xlWS
.Range("A" & CStr(intRow)).Value = Me.lstGranteeSearch.Column(1)
' copies the Contact Name
.Range("B" & CStr(intRow)).Value = strLName
.Range("C" & CStr(intRow)).Value = strFName
' copies the role
.Range("D" & CStr(intRow)).Value = strRole
' copies the Address information -
' Address 1
.Range("E" & CStr(intRow)).Value = strAddress1
' Address 2
.Range("F" & CStr(intRow)).Value = strAddress2
' City
.Range("G" & CStr(intRow)).Value = strCity
' State
.Range("H" & CStr(intRow)).Value = strState
' Zip Code
.Range("I" & CStr(intRow)).Value = strZip
' Phone
.Range("J" & CStr(intRow)).Value = strPhone
' Email Address
.Range("K" & CStr(intRow)).Value = strEmail
' FAX
.Range("L" & CStr(intRow)).Value = strFax
End With
intCount = intCount + 1
intRow = intRow + 1
Loop
With xlWS
.Cells.Select
.Cells.EntireColumn.AutoFit
.Range("A1").Select
End Select
objExcel.WindowState = xlMaximized
objExcel.Visible = True