dates VBA

R

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
672
Office Version
  1. 365
Platform
  1. Windows
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

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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Maybe the 'End With' just before the 'End Sub' line should be an 'End If'
 
Upvote 0
This happens when you have a block (If or With or maybe even loops) that are not terminated properly. An End With can be seen as having no With because and End If is missing. Hard to say from looking at your code exactly where an End If is needed because one needs to know the logic of the nested If's.
It looks to me like your code is not properly indented, making it harder to spot.
 
Upvote 0
This block is not terminated:
If IncludeIntakeDate And IntakeDate <> "" Then
but I'm assuming you want the commented code to be left in. How I would probably write it:
VBA 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, ParticipantName As String, IntakeDate As String, DDRO As String, DocStatus As String
Dim r As Long, nr As Long: nr = sr + 1
Dim col As Long, MonthsPassed As Long, 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 If '<<<< missing end if here
End With
End Sub
 
Upvote 0
hi
thanks for the heads-up
i was missing an end if
it works now
thanks
 
Upvote 0
You could mark this as solved then, so that other's don't open for review only to see that it is solved.
Thanks.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Multiple columns into 2?
Replies
6
Views
114
Georgiboy
Georgiboy
S
  • Question
Date formatting issue sheet to VBA Array to Sheet
Replies
2
Views
155
MARK858
MARK858
R
  • Question
VBA daydiff vs Monthdiff
Replies
1
Views
307
bebo021999
B
S
  • Question
Scan Attendance
Replies
1
Views
289
Stewart11715
S
L
  • Solved
VBA Run-time Errors
Replies
3
Views
518
StephenCrump
S

Forum statistics

Threads
1,215,127
Messages
6,123,203
Members
449,090
Latest member
bes000

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top