Loop without Do Error

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
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
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:

Vindaloo

New Member
Joined
Jul 15, 2014
Messages
29
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
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
Code:
For Each ws In ...
Where's the Next ws statement for that?
 

Vindaloo

New Member
Joined
Jul 15, 2014
Messages
29

ADVERTISEMENT

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
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
Every For statement requires a Next statement

Code:
                i = i + 1
[COLOR="#FF0000"]            Next ws[/COLOR]
        Loop
 

Vindaloo

New Member
Joined
Jul 15, 2014
Messages
29

ADVERTISEMENT

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.
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
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:

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,770
Office Version
  1. 2010
Platform
  1. Windows
This ...

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

should be

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

Watch MrExcel Video

Forum statistics

Threads
1,109,518
Messages
5,529,314
Members
409,863
Latest member
stacy09
Top