hi
i messed up in my code
it is giving me endwith without with
the red is what i added and messed up
please assit
i messed up in my code
it is giving me endwith without with
the red is what i added and messed up
please assit
Rich (BB code):
Sub WriteToTemplate(wsTemplate As Worksheet, rng As Range, sr As Long, ClearReport As Boolean, IncludeIntakeDate As Boolean)
Dim tblDefaults As ListObject: Set tblDefaults = Worksheets("Startup Applications").ListObjects("tblDDRODefaults")
Dim TabsID As String
Dim ParticipantName As String
Dim IntakeDate As String
Dim DDRO As String
Dim r As Long
Dim nr As Long: nr = sr + 1
Dim col As Long
Dim DocStatus As String
Dim MonthsPassed As Long
Dim DaysPassed As Long
'Variables
DDRO = rng(1, 2)
TabsID = rng(1, 3)
ParticipantName = rng(1, 1)
IntakeDate = rng(1, 5)
With wsTemplate
'Clear Template
If ClearReport = True Then
.Range("A4:B1000").Clear
.Range("A4:B1000").Interior.ColorIndex = xlNone
End If
'Need "headers" for this group
If sr <> 3 Then
.Range("A1:B3").Copy Destination:=.Range("A" & nr & ":B" & nr + 2)
nr = nr + 3
sr = sr + 3
End If
For r = 1 To tblDefaults.ListRows.Count
If tblDefaults.ListColumns("DDRO Type").DataBodyRange(r) = DDRO Then
.Cells(sr - 2, "B") = ParticipantName
.Cells(sr - 1, "B") = TabsID
.Cells(sr, "B") = GetDDRODescription(DDRO)
If tblDefaults.ListColumns("Default Value").DataBodyRange(r) = "0" Then
col = tblDefaults.ListColumns("Column").DataBodyRange(r)
.Range("A3:B3").Copy Destination:=.Range("A" & nr & ":B" & nr)
.Cells(nr, "A") = tblDefaults.ListColumns("Header").DataBodyRange(r)
DocStatus = Replace(rng(1, col), " ", " ")
If DocStatus = "0" Then
.Cells(nr, "B") = "Not Submitted"
.Cells(nr, "B").Font.Bold = False
.Cells(nr, "B").Interior.Color = vbCyan
ElseIf DocStatus = "X" Then
.Cells(nr, "B") = "Submitted Incorrectly"
.Cells(nr, "B").Font.Bold = False
.Cells(nr, "B").Interior.Color = 65535
ElseIf InStr(DocStatus, "X") > 0 Then
.Cells(nr, "B") = Replace(rng(1, col), "X ", "")
.Cells(nr, "B").Font.Bold = False
.Cells(nr, "B").Interior.Color = 65535
ElseIf InStr(DocStatus, "0") = 1 Then
.Cells(nr, "B") = Replace(rng(1, col), "0 ", "")
.Cells(nr, "B").Interior.Color = RGB(255, 204, 204)
.Cells(nr, "B").Font.Bold = False
ElseIf AscW(DocStatus & " ") = 10004 Then
.Cells(nr, "B") = "Submitted Correctly"
.Cells(nr, "B").Font.Bold = False
Else
.Cells(nr, "B") = DocStatus
.Cells(nr, "B").Font.Bold = False
End If
nr = nr + 1
End If
End If
Next r
'Intake Date
If IncludeIntakeDate And IntakeDate <> "" Then
MonthsPassed = DateDiff("m", CDate(IntakeDate), Date)
DaysPassed = DateDiff("d", CDate(IntakeDate), Date)
' If DaysPassed <= 29 Then
' .Range("A3:B3").Copy Destination:=.Range("A" & nr & ":B" & nr)
' If DaysPassed >= 7 And DaysPassed <= 13 Then
' .Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & DaysPassed & " 1 week has passed. Do you want to continue?"
' ElseIf DaysPassed >= 14 And DaysPassed <= 20 Then
' .Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & DaysPassed & " 2 weeks have passed. Do you want to continue?"
' ElseIf DaysPassed >= 21 And DaysPassed <= 29 Then
' .Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & DaysPassed & " 3 weeks have passed. Do you want to continue?"
' End If
If DaysPassed >= 30 Then
.Range("A3:B3").Copy Destination:=.Range("A" & nr & ":B" & nr)
If MonthsPassed > 1 And MonthsPassed < 3 Then
.Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & MonthsPassed & " months have passed. Do you want to continue?"
ElseIf MonthsPassed >= 3 Then
.Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & MonthsPassed & " months have passed. Do you want to continue?"
.Range("A" & nr & ":B" & nr).Font.Color = 255
Else
.Cells(nr, "A") = "Intake Date was " & IntakeDate & ", " & MonthsPassed & " month has passed. Do you want to continue?"
End If
.Cells(nr, "B").ClearContents
.Range("A" & nr & ":B" & nr).Merge
.Range("A" & nr & ":B" & nr).Font.Size = 10
nr = nr + 1
End If
End If
End With
End Sub