Loop without Do Error

Vindaloo

Vindaloo

New Member
Joined
Jul 15, 2014
Messages
29
I keep getting this error no matter where I stick End If functions. I'm hoping a fresh pair of eyes can tell me where this is coming from.

Code: 
Sub Import()
'
' Import Macro
'
'
    Dim File_Name As String
    Dim High_Folder As String
    Dim Low_Folder As String
    Dim Path As String
    Dim i As Integer
    Dim TestStr As String
    Dim ws As Worksheet
    i = 11
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    With Worksheets("Control")
    
    Do Until .Cells(i, 4).Value = ""
    
    Sheets("Control").Select
    File_Name = Cells(i, 4).Value
    High_Folder = Cells(i, 5).Value
    Low_Folder = Cells(i, 6).Value
    Path = Cells(i, 7).Value
    
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    
    TestStr = ""
        On Error Resume Next
        TestStr = Dir(Path)
        On Error GoTo 0
        
            If TestStr = "" Then
                'Do Nothing
            Else
    Workbooks.Open Filename:= _
        Path
            End If
    
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "BnrTrans" And ws.Name <> "PAT PAYMENTS" And ws.Name <> "COMM INS" And ws.Name <> "DRAWER 1" And ws.Name <> "DRAWER 2" And ws.Name <> "CREDIT CARDS" And ws.Name <> "DRAWER 3" And ws.Name <> "CLINIC DISP" And ws.Name <> "WHITE RECEIPTS" And ws.Name <> "DEPOSIT DIST" And ws.Name <> "DDIS Page 1 Bnr" And ws.Name <> "DDIS Page 2 Bnr" And ws.Name <> "DDIS-CHG CARDS Bnr" And ws.Name <> "DDIS-WIRES Bnr" And ws.Name <> "WORK AREA" Then
    Range("A3:F500").Select
    Selection.Copy
    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
    Sheets("WIRES-OTHER").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "SOURCE"
   Range("A2:F10000").Select
    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Add Key:=Range( _
        "A3:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("WIRES-OTHER").Sort
        .SetRange Range("A2:F10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Windows(File_Name).Select
    Windows(File_Name).Close savechanges:=False
    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
    Sheets("Control").Select
    End If
  
 
  i = i + 1
  
Loop
    
End With
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Sort by date Sort by votes
If you'll indulge me, I indented your code with StephenBullen's SmartIndenter (http://www.oaltd.co.uk/indenter/default.htm). All the Do/Loops, If/Endif, SectCase/End Select should align. Do you see the problem? (It will be easier to check if you paste it back in the IDE.)

Code: 
Option Explicit

Sub Import()
    ' Import Macro
    Dim File_Name   As String
    Dim High_Folder As String
    Dim Low_Folder  As String
    Dim Path        As String
    Dim i           As Integer
    Dim TestStr     As String
    Dim ws          As Worksheet
    
    i = 11

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    With Worksheets("Control")

        Do Until .Cells(i, 4).Value = ""

            Sheets("Control").Select
            File_Name = Cells(i, 4).Value
            High_Folder = Cells(i, 5).Value
            Low_Folder = Cells(i, 6).Value
            Path = Cells(i, 7).Value

            Application.DisplayAlerts = False
            Application.AskToUpdateLinks = False

            TestStr = ""
            On Error Resume Next
            TestStr = Dir(Path)
            On Error GoTo 0

            If TestStr = "" Then
                'Do Nothing
            Else
                Workbooks.Open Filename:= _
                               Path
            End If

            For Each ws In ActiveWorkbook.Worksheets
                If ws.Name <> "BnrTrans" And ws.Name <> "PAT PAYMENTS" And ws.Name <> "COMM INS" And ws.Name <> "DRAWER 1" And ws.Name <> "DRAWER 2" And ws.Name <> "CREDIT CARDS" And ws.Name <> "DRAWER 3" And ws.Name <> "CLINIC DISP" And ws.Name <> "WHITE RECEIPTS" And ws.Name <> "DEPOSIT DIST" And ws.Name <> "DDIS Page 1 Bnr" And ws.Name <> "DDIS Page 2 Bnr" And ws.Name <> "DDIS-CHG CARDS Bnr" And ws.Name <> "DDIS-WIRES Bnr" And ws.Name <> "WORK AREA" Then
                    Range("A3:F500").Select
                    Selection.Copy
                    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
                    Sheets("WIRES-OTHER").Select
                    Range("A1").Select
                    Selection.End(xlDown).Select
                    ActiveCell.Offset(1, 0).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                    :=False, Transpose:=False
                    Application.CutCopyMode = False
                    ActiveCell.FormulaR1C1 = "SOURCE"
                    Range("A2:F10000").Select
                    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Clear
                    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Add Key:=Range( _
                                                                                      "A3:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                                                                                 xlSortNormal
                    With ActiveWorkbook.Worksheets("WIRES-OTHER").Sort
                        .SetRange Range("A2:F10000")
                        .Header = xlYes
                        .MatchCase = False
                        .Orientation = xlTopToBottom
                        .SortMethod = xlPinYin
                        .Apply
                    End With

                    Windows(File_Name).Select
                    Windows(File_Name).Close savechanges:=False
                    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
                    Sheets("Control").Select
                End If

                i = i + 1
            Loop

        End With
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationAutomatic
    End Sub
Notice that End Sub is indented; it shouldn't be.
 
Last edited:
Upvote 0
I think there is a With/End With issue, but I can't figure out where to put the End With to make it run
 
Upvote 0
Code: 
For Each ws In ...
Where's the Next ws statement for that?
 
Upvote 0
I've never used a Next ws statement before. I can't figure out where it is supposed to go. It gives me an error for Windows(File_Name).Select.

Code: 
Sub Import()
'
' Import Macro
'
'
    Dim File_Name As String
    Dim High_Folder As String
    Dim Low_Folder As String
    Dim Path As String
    Dim i As Integer
    Dim TestStr As String
    Dim ws As Worksheet
    i = 11
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    With Worksheets("Control")
    Do Until .Cells(i, 4).Value = ""
    
    Sheets("Control").Select
    File_Name = Cells(i, 4).Value
    High_Folder = Cells(i, 5).Value
    Low_Folder = Cells(i, 6).Value
    Path = Cells(i, 7).Value
    
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    
    TestStr = ""
        On Error Resume Next
        TestStr = Dir(Path)
        On Error GoTo 0
        
            If TestStr = "" Then
                'Do Nothing
            Else
    Workbooks.Open Filename:= _
        Path
            End If
    
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "BnrTrans" And ws.Name <> "PAT PAYMENTS" And ws.Name <> "COMM INS" And ws.Name <> "DRAWER 1" And ws.Name <> "DRAWER 2" And ws.Name <> "CREDIT CARDS" And ws.Name <> "DRAWER 3" And ws.Name <> "CLINIC DISP" And ws.Name <> "WHITE RECEIPTS" And ws.Name <> "DEPOSIT DIST" And ws.Name <> "DDIS Page 1 Bnr" And ws.Name <> "DDIS Page 2 Bnr" And ws.Name <> "DDIS-CHG CARDS Bnr" And ws.Name <> "DDIS-WIRES Bnr" And ws.Name <> "WORK AREA" Then
    Range("A3:F500").Select
    Selection.Copy
    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
    Sheets("WIRES-OTHER").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "SOURCE"
   Range("A2:F10000").Select
    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("WIRES-OTHER").Sort.SortFields.Add Key:=Range( _
        "A3:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("WIRES-OTHER").Sort
        .SetRange Range("A2:F10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    End If
    Next ws
    
    Windows(File_Name).Select
    Windows(File_Name).Close savechanges:=False
    Windows("DDIS Batch Generic Data Importer.xlsm").Activate
    Sheets("Control").Select
    
 
  i = i + 1
Loop
    
End With
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Every For statement requires a Next statement

Code: 
                i = i + 1
[COLOR="#FF0000"]            Next ws[/COLOR]
        Loop
 
Upvote 0
In my code, the i=i+1 is designed to select the next workbook. by the time I get to i=i+1, I have already closed the source workbook and am looking for the next. The for next is supposed to go through my source file, pull all non-exempted tabs 1 at a time, dump them into the target file tab, sort that tab so that I remove blanks and other garbage. The code stops because it is not able to return to the source after dumping.
 
Upvote 0
Your code is hard to follow. Maybe ...

Code: 
Sub Import()
    Dim wks         As Worksheet
    Dim wksTgt      As Worksheet
    Dim wksCtl      As Worksheet

    Dim sFile       As String
    Dim sPath       As String
    Dim iRow        As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False

    Set wksCtl = Workbooks("DDIS Batch Generic Data Importer.xlsm").Worksheets("Control")
    Set wksTgt = Workbooks("DDIS Batch Generic Data Importer.xlsm").Worksheets("WIRES-OTHER")

    iRow = 11

    Do
        sFile = wksCtl.Cells(iRow, "D").Value
        If Len(sFile) = 0 Then Exit Do
        sPath = wksCtl.Cells(iRow, "G").Value

        If Len(Dir(sPath)) Then
            With Workbooks.Open(Filename:=sPath)

                For Each wks In .Worksheets
                    Select Case wks.Name
                        Case "BnrTrans", "PAT PAYMENTS", "COMM INS", "DRAWER 1", "DRAWER 2", _
                             "CREDIT CARDS", "DRAWER 3", "CLINIC DISP", "WHITE RECEIPTS", _
                             "DEPOSIT DIST", "DDIS Page 1 Bnr", "DDIS Page 2 Bnr", _
                             "DDIS-CHG CARDS Bnr", "DDIS-WIRES Bnr", "WORK AREA"

                        Case Else
                            Range("A3:F500").Copy
                            With wksTgt
                                With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
                                    .PasteSpecial Paste:=xlPasteValues
                                    .Cells(1).Value = "SOURCE"
                                End With
                                .Range("A2:F10000").Sort Key1:=.Range("A2"), Header:=xlYes
                            End With
                    End Select
                Next wks

                .Close SaveChanges:=False
            End With
        End If

        iRow = iRow + 1
    Loop

    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

EDIT: Oops -- missed a line.
 
Last edited:
Upvote 0
This ...

Code: 
Range("A3:F500").Copy

should be

Code: 
wks.Range("A3:F500").Copy
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Copy and paste rows with a criteria
Replies
9
Views
229
JannetteChristie
J
R
  • Question Question
I need help with Combining VBA code. Im not sure how to properly combine. Thanks
Replies
2
Views
108
RyanHawkeye
R
R
  • Question Question
Add a code or number at the end of the file name using VBA (Looped)
Replies
3
Views
350
HighAndWilder
H
S
  • Question Question
Run Time Error 5 - In converting PDF sheets in a workbook into individual PDFs
Replies
4
Views
169
Micron
M
P
  • Question Question
Error on Loop
Replies
3
Views
443
Pestomania
P

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