VBA Compile Error

V

vtapia

New Member
Joined
Jun 22, 2011
Messages
5
For some reason, I cannot debug this code, the error is "Next without For"
I have looked at it forever and I can't figure out where I am missing an end if along the way. I would really appreciate a second hand of eyes.
Code: 
Sub Filter_Dates()
    Dim ws_Dest1 As Worksheet
    Dim ws_Srce1 As Worksheet
    Dim DCount As Double
    Dim prdDate As String 'first set of dates (Yr-Period-Week format)
    Dim insDate As String '2nd set of dates (same format)
    Dim Dict_Year As New Scripting.Dictionary
    Dim Dict_Period As New Scripting.Dictionary
    Dim Dict_Week As New Scripting.Dictionary
    Dim Dict_Dates As New Scripting.Dictionary
    Dim Dict_FilterBP As New Scripting.Dictionary
    Dim Dict_FilterNames As New Scripting.Dictionary
    Dim dateKey As String
    Dim yearKey As String
    Dim periodKey As String
    Dim weekKey As String
    Dim temp_Date As String
    Dim temp_year As String
    Dim temp_period As String
    Dim temp_week As String
    Dim filterBP As String
    Dim filterName As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Create a new BP list by looping through BPlist Sheet
    Set ws_Dest1 = s_BPSummary
    Set ws_Srce1 = s_BPList
    
    DCount = ws_Srce1.Range("E65536").End(xlUp).Row
    'filter/search fields
    temp_year = ws_Dest1.Range("E2")
    temp_period = ws_Dest1.Range("E3")
    temp_week = ws_Dest1.Range("E4")
    temp_Date = temp_year & "-" & temp_period & "-" & temp_week
    
For x = 3 To DCount
  '001
  If temp_year = "" And temp_period = "" And temp_week <> "" Then
       If temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
       End If
       ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
       End If
  End If
  '010
  ElseIf temp_year = "" And temp_period <> "" And temp_week = "" Then
        If temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
  End If
  '011
  ElseIf temp_year = "" And temp_period <> "" And temp_week <> "" Then
       If temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
       End If
       ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
       End If
       ElseIf temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
       End If
       ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
       End If
  End If
  
  '100
  ElseIf temp_year <> "" And temp_period = "" And temp_week = "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
  End If
  
  '101
  ElseIf temp_year <> "" And temp_period = "" And temp_week <> "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
        If temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
  End If
  '110
  ElseIf temp_year <> "" And temp_period <> "" And temp_week = "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
        ElseIf temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
  End If
'111
  ElseIf temp_year <> "" And temp_period <> "" And temp_week <> "" Then
        If temp_Date = ws_Srce1.Range("C" & x) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
        End If
        ElseIf temp_Date = ws_Srce1.Range("D" & x) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
        End If
  End If
Next x 'ERROR

    ws_Dest1.Range("AA4:AA65536").ClearContents
    
    'Unload Dictionaries on Destination page
    DCount = ws_Dest1.Range("B65536").End(xlUp).Row
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Thanks!
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
This error is almost always missleading...

You had an If that should have been an ElseIf
And you were missing an End If at the very end...

Proper indentation helps to see these problems...

This at least compiles, no idea if it does what you want though....

Code: 
Sub Filter_Dates()
Dim ws_Dest1 As Worksheet
Dim ws_Srce1 As Worksheet
Dim DCount As Double
Dim prdDate As String 'first set of dates (Yr-Period-Week format)
Dim insDate As String '2nd set of dates (same format)
Dim Dict_Year As New Scripting.Dictionary
Dim Dict_Period As New Scripting.Dictionary
Dim Dict_Week As New Scripting.Dictionary
Dim Dict_Dates As New Scripting.Dictionary
Dim Dict_FilterBP As New Scripting.Dictionary
Dim Dict_FilterNames As New Scripting.Dictionary
Dim dateKey As String
Dim yearKey As String
Dim periodKey As String
Dim weekKey As String
Dim temp_Date As String
Dim temp_year As String
Dim temp_period As String
Dim temp_week As String
Dim filterBP As String
Dim filterName As String
Application.ScreenUpdating = False
Application.EnableEvents = False
 
'Create a new BP list by looping through BPlist Sheet
Set ws_Dest1 = s_BPSummary
Set ws_Srce1 = s_BPList
DCount = ws_Srce1.Range("E65536").End(xlUp).Row
'filter/search fields
temp_year = ws_Dest1.Range("E2")
temp_period = ws_Dest1.Range("E3")
temp_week = ws_Dest1.Range("E4")
temp_Date = temp_year & "-" & temp_period & "-" & temp_week
 
For x = 3 To DCount
    '001
    If temp_year = "" And temp_period = "" And temp_week <> "" Then
        If temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
    '010
    ElseIf temp_year = "" And temp_period <> "" And temp_week = "" Then
        If temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
    '011
    ElseIf temp_year = "" And temp_period <> "" And temp_week <> "" Then
        If temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        ElseIf temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
 
    '100
    ElseIf temp_year <> "" And temp_period = "" And temp_week = "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
 
    '101
    ElseIf temp_year <> "" And temp_period = "" And temp_week <> "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        ElseIf temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
    '110
    ElseIf temp_year <> "" And temp_period <> "" And temp_week = "" Then
        If temp_year = Mid(ws_Srce1.Range("C" & x), 1, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_year = Mid(ws_Srce1.Range("D" & x), 1, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        ElseIf temp_period = Mid(ws_Srce1.Range("C" & x), 4, 2) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_period = Mid(ws_Srce1.Range("D" & x), 4, 2) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
    '111
    ElseIf temp_year <> "" And temp_period <> "" And temp_week <> "" Then
        If temp_Date = ws_Srce1.Range("C" & x) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
        ElseIf temp_Date = ws_Srce1.Range("D" & x) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
        End If
    End If
Next x 'ERROR
ws_Dest1.Range("AA4:AA65536").ClearContents
 
'Unload Dictionaries on Destination page
DCount = ws_Dest1.Range("B65536").End(xlUp).Row
 
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
Upvote 0
Glad to help...

And what I mean by proper indentation is


I've color coded the IF End If and Else If's so you can visualize which ones are associated with each other...

This
Rich (BB code): 
  If temp_year = "" And temp_period = "" And temp_week <> "" Then
       If temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
       End If
       ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
       End If
  End If
  '010
  ElseIf temp_year = "" And temp_period <> "" And temp_week = "" Then

Should look like this
Rich (BB code): 
  If temp_year = "" And temp_period = "" And temp_week <> "" Then
       If temp_week = Mid(ws_Srce1.Range("C" & x), 7, 1) Then
            filterBP = ws_Srce1.Range("A" & x)
            If Not Dict_FilterBP.Exists(filterBP) Then
                Dict_FilterBP.Add filterBP, filterBP
            End If
       ElseIf temp_week = Mid(ws_Srce1.Range("D" & x), 7, 1) Then
            filterName = ws_Srce1.Range("E" & x)
            If Not Dict_FilterNames.Exists(filerName) Then
                Dict_FilterNames.Add filterName, filterName
            End If
       End If
  '010
  ElseIf temp_year = "" And temp_period <> "" And temp_week = "" Then


Now, this indentation is not required for the code to work properly, it is just for visual aid.
It helps to find those "missing" End If's


Hope that helps.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA Code to Send Mail to skip blank cells
Replies
1
Views
304
Micron
M
KlausW
  • Solved
Excel VBA Error - Unable to get the Insert property of the Picture Class
Replies
7
Views
387
KlausW
KlausW
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
264
RoryA
RoryA
G
  • Solved
Run-Time Error 381
2
Replies
12
Views
197
Micron
M
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
107
RoryA
RoryA

Forum statistics

Threads
1,224,508
Messages
6,179,189
Members
452,893
Latest member
denay

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