Here is my save file code, including the print and new site code.


Code
-------------------

Sub FileSave()
On Error Resume Next
Dim strFileName As String
Dim strDir As String
Dim strSite As String
Dim strSiteType As String
Dim strNewFile As String

strDir = "G:\CHCS\_MHS\TIMPO\VPN\SiteSpecificDocs\"
strSite = Sheets("Addressing").Range("I7").Value
strDirName = Sheets("Addressing").Range("D2").Value
strFileName = Sheets("Addressing").Range("D28").Value

If strSite = "f" Then
strSiteType = "_Air Force"
Else
End If

If strSite = "a" Then
strSiteType = "_Army"
Else
End If

If strSite = "n" Then
strSiteType = "_Navy"
Else
End If

If strSite = "m" Then
strSiteType = "_Navy"
End If

' Check for Site Directory
On Error Resume Next
MkDir strDir & strSiteType & "\" & strDirName
On Error GoTo 0

' Save file here
strNewFile = strDir & strSiteType & "\" & strDirName & "\" & strFileName & " VPN IP Address.XLS"

MsgBox "Saving File " & strNewFile, vbOKCancel = 1

ActiveWorkbook.SaveAs strNewFile, FileFormat:=xlNormal

End Sub

Sub PrintSite()
Dim response
Sheet1.PrintOut
response = MsgBox("Do you need another copy?", vbYesNo + vbQuestion, "Confirmation")
If response = vbNo Then
Call FillSiteList
Call NewSite
Else
End If
End Sub

Private Sub FillSiteList()
Dim rngAsnNumber As Range
Set rngAsnNumber = Range("Sites!A2:A1000")
For i = 1 To 1000
With rngAsnNumber
If .Cells(i, 1) = "" Then
.Cells(i, 1).Value = Sheet1.Range("J9").Value
.Cells(i, 2).Value = Sheet1.Range("O9").Value
.Cells(i, 3).Value = Sheet1.Range("D2").Value
.Cells(i, 4).Value = Sheet1.Range("D3").Value
.Cells(i, 5).Value = Sheet1.Range("D4").Value
.Cells(i, 6).Value = Sheet1.Range("D5").Value
.Cells(i, 7).Value = Sheet1.Range("D6").Value
.Cells(i, 8).Value = Sheet1.Range("D7").Value
.Cells(i, 9).Value = Sheet1.Range("D8").Value
.Cells(i, 10).Value = Sheet1.Range("D9").Value
.Cells(i, 11).Value = Sheet1.Range("S2").Value
.Cells(i, 12).Value = Sheet1.Range("S3").Value
.Cells(i, 13).Value = Sheet1.Range("H8").Value
.Cells(i, 14).Value = Sheet1.Range("H9").Value
Exit For
End If
End With
Next i
End Sub

Sub NewSite()
Dim rngAsnNumber As Range

Call FillSiteList
Call FileSave

Sheet1.Range("H8").Select
Set rngAsnNumber = Range("Sites!E2:E1000")
For i = 1 To 1000
If rngAsnNumber.Cells(i, 1) = "" Then
If Not IsNumeric(rngAsnNumber.Cells(i - 1, 1).Value) Then

Sheet1.Range("H8").Value = Sheets("Sites").Range("M65536").End(xlUp).Value - 1
Else
Sheet1.Range("H8").Value = rngAsnNumber.Cells(i - 1, 1).Value - 1
End If
Exit For
End If
Next i

End Sub

-------------------

--
swieduw
-----------------------------------------------------------------------
swieduwi's Profile: http://www.excelforum.com/member.php...fo&userid=2196
View this thread: http://www.excelforum.com/showthread.php?threadid=38014