Don Guillett wrote:
It would be nice if we could see the code.
This group is so picky! :)
Here's the code:
Sub CreateTribalSheet()
Dim sFacilName As String
Dim lNextRow As Long
Dim lBaseRow As Long
Dim lLimitRow As Long
Dim lFacilName As Long
Dim lPrevSumRow As Long
Dim ws As Worksheet
Dim bNameEnt As Boolean
If ActiveSheet.Name = "Source" Then
MsgBox "Please choose a different sheet to create the Tribal sheet
from!", vbOKOnly
Exit Sub
End If
lNextRow = 2
lBaseRow = lNextRow
lPrevSumRow = 1
bNameEnt = False
Set ws = ActiveSheet
' Get facility name and no. of records from user
EnterFacilNames:
bCancel = False
lFacilRows = 0
frmFacil.Show
If bCancel = True Then
If bNameEnt = False Then
Exit Sub
Else
With ActiveSheet
.Cells(lNextRow, "H") = "Monthly Totals"
.Cells(lNextRow, "I").Formula = "=SUMIF($h$2:$h$" & _
lNextRow - 1 & ",""totals"",i2:i" & lNextRow - 1 & ")"
Range("I" & lNextRow).Select
Selection.AutoFill Destination:=Range("I" & lNextRow & ":n"
_
& lNextRow), Type:=xlFillDefault
End With
Exit Sub
End If
End If
sFacilName = frmFacil.tbFacilName.Text
If sFacilName = "" Then
GoTo NoData
End If
On Error Resume Next
lFacilRows = frmFacil.tbFacilRows.Value
On Error GoTo 0
If lFacilRows = 0 Then
NoData:
MsgBox "Please enter a Facility Name and the number of clients!",
vbOKOnly
GoTo EnterFacilNames
End If
bNameEnt = True
Workbook ("Tribal Test.xls")
Sheets("Source").Select
' Enter column headers from Source sheet
Range("A1:N1").Select
Selection.Copy
ws.Select
Range("a1").Select
ActiveSheet.Paste
lLimitRow = lBaseRow + lFacilRows
lPrevSumRow = lNextRow
Unload frmFacil
Do Until lNextRow = lLimitRow
With ActiveSheet
.Cells(lNextRow, 2) = sFacilName
'Insert formula =IF(G2<"",DATEDIF(G2,H2,"d")+1,"") with
lPrevSumRow as the row
.Cells(lNextRow, "I").Formula = "=IF(G" & lNextRow &
"<"""",DATEDIF(G" _
& lNextRow & ",H" & lNextRow & ",""d"")+1,"""")"
lNextRow = lNextRow + 1
End With
Loop
' Enter Totals row
With ActiveSheet
.Cells(lNextRow, "H") = "Totals"
.Cells(lNextRow, "I").Formula = "=Sum(i" & lPrevSumRow & ":i" _
& lNextRow - 1 & ")"
.Range("I" & lNextRow).Select
Selection.AutoFill Destination:=Range("I" & lNextRow & ":M" _
& lNextRow), Type:=xlFillDefault
'Enter row totals
' =SUM(J4:M4)
.Cells(lPrevSumRow, "n").Formula = "=sum(j" & lPrevSumRow & _
":m" & lPrevSumRow & ")"
.Range("n" & lPrevSumRow).Select
Selection.AutoFill Destination:=Range("n" & lPrevSumRow & ":n" _
& lNextRow), Type:=xlFillDefault
' Color totals row yellow
.Range("A" & lNextRow & ":" & "N" & lNextRow).Select
Selection.Interior.ColorIndex = 6
End With
lNextRow = lNextRow + 1
lBaseRow = lNextRow
GoTo EnterFacilNames
End Sub
--
Don Guillett
SalesAid Software
"davegb" wrote in message
oups.com...
The following code creates a spreadsheet by getting user input on the
"Facility Name" and the number of clients that facility served during
the month. The user fills in the blank fields after filling out the
form. The macro creates the nearly blank rows for the data and a row of
subtototals. When the user clicks "Cancel", the macro puts in a row of
Overall Totals at the bottom. It works fine. But it uses 3 Goto
commands (it had 5 before I cleaned it up a bit) and I understand gotos
are no-nos for good coding. I'm interested in feedback to see if
there's a way to use less of them. Two of the three are for error
handling in case the user failed to enter both required pieces of data.
I'm also interested in any other input on my coding. Thanks to anyone
who gives me feedback, and even more thanks if you think I did
something right! :)