Solved: Problem Using If Function in VBA

[LucasLondon]

Hi,

I've put this code together to loop through files in a folder and perform an action. On the whole it works fine until I tried to entering a condition using the if statement. I only want the code to copy the range specified and call the procedure "rest" if cell B6 contains the value "Monthly". If however this condition isn't met, then I want the code to close the current file and move on to the next workbook (i) and do the same.

Currently I'm getting a "next without for" error. Any ideas how to fix?

Thanks,

Lucas



Sub Final()
Dim i, y As Integer, wb As Workbook
Dim name As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Files\Test\"
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
'Perform the operation on the open workbook
wb.Select
If Range("b6").Value = "Monthly" Then
x = Range("A13")
Range("b13").Select
Range(ActiveCell, Selection.End(xlDown)).Copy

name = ActiveSheet.name
Call rest
Else:
wb.close
Next i
End If
End Sub

[mikerickson]

Sub Final2()
Dim i, y As Integer, wb As Workbook
Dim name As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Files\Test\"
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
'Perform the operation on the open workbook
wb.Select
If Range("b6").Value = "Monthly" Then
x = Range("A13")
Range("b13").Select
Range(ActiveCell, Selection.End(xlDown)).Copy

name = ActiveSheet.name
Call rest
Else
wb.close
End If
Next i
End With
End Sub
or perhaps this, if you want a "Monthly" workbook to be closed after rest-ing.
Sub Final3()
Dim i, y As Integer, wb As Workbook
Dim name As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Files\Test\"
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
For i = 1 To .FoundFiles.Count
'Open each workbook
Set wb = Workbooks.Open(Filename:=.FoundFiles(i))
'Perform the operation on the open workbook
wb.Select
If Range("b6").Value = "Monthly" Then
x = Range("A13")
Range("b13").Select
Range(ActiveCell, Selection.End(xlDown)).Copy

name = ActiveSheet.name
Call rest
End If

wb.close

Next i
End With
End Sub

[Paul_Hossler]

Just a matter of being careful with the 'bracketing' statement pairs

I noticed that you were off with some, and when they're out of order you get that message


Sub

....With

........For i =

............If

............ElseIf

............Else ' no colon - that marks a Label

............EndIf

........Next i

....End With

End Sub

Paul

[LucasLondon]

Thanks guys.

The ammended code seemed to have fixed the issue. But when I tried running it in Excel 2007 the code didn't work due to file search not being supported. I have made the following changes

1) Changed the code to run in 2007
2) Instead of using an if statement I'm now using a select case statement because I have mutiple criteria to evaluate. However I think I have not done it 100% correctly and would be great if someone can confirm. The key thing I'm not sure about here is the case else and end select statement and whether I have put them in the right place.

As previously, if none of the criteria/cases are met then, I want to close the open workbook and move onto the next file.

Thanks,

Lucas



Sub Consolidate_2007()

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

Dim folderPath As String
Dim filename As String
Dim WB As Workbook
Dim i, y, startrow As Integer
Dim x As Date
Dim name As String
Dim wkname As String

folderPath = "C:\Files\Test\"
filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Set WB = Workbooks.Open(folderPath & filename)

Select Case Range("b6").Value
Case "Monthly"
wkname = "Monthly"
Case "Quarterly"
wkname = "Quarterly"
Case "Weekly"
wkname = "Weekly"

Case Else
WB.Close
End Select

Range("A1:A26").Select
Selection.Find(What:="date", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
On Error Resume Next

startrow = ActiveCell.Row + 1
x = Range("A" & startrow)

' x = Range("A13")
Range("b" & startrow).Select
Range(ActiveCell, Selection.End(xlDown)).Copy

name = ActiveSheet.name & "-" & Range("b1").Value

Workbooks("Consolidate Timeseries Files").Activate


Sheets(wkname).Select
With Sheets(wkname).Range("A:A")
Set Rng = .Find(What:=x, _
After:=Sheets(wkname).Range("a1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
' MsgBox "Nothing found"
End If
End With

y = ActiveCell.Row
Z = Range("XFD1").End(xlToLeft).Column + 1 'XFD LAST COL IN 2007
Cells(y, Z).Select
ActiveSheet.Paste
Cells(1, Z).Value = name
WB.Close
filename = Dir
Loop
Application.Calculation = xlCalculationAutomatic
End Sub

[Aussiebear]

Did you turn your Application.ScreenUpdating and Application.DisplayAlerts back on?

[Aflatoon]

You appear to still be trying to process the workbook even if you close it. I would suggest making the processing part a different routine called from your loop. Please try this:


Sub Consolidate_2007()

Dim WB As Excel.Workbook
Dim wbConsolidated As Excel.Range
Dim wsSource As Excel.Worksheet
Dim i As Long
Dim folderPath As String
Dim filename As String
Dim wkname As String

On Error GoTo error_handler

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With

Set wbConsolidated = Workbooks("Consolidate Timeseries Files")

folderPath = "C:\Files\Test\"
filename = Dir(folderPath & "*.xls")

Do While filename <> ""
Set WB = Workbooks.Open(folderPath & filename)
Set wsSource = WB.ActiveSheet

wkname = wsSource.Range("b6").Value
Select Case wkname
Case "Monthly", "Quarterly", "Weekly"
CopyData wsSource, wbConsolidated, wkname
End Select

WB.Close SaveChanges:=False
filename = Dir
Loop


leave:
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
Exit Sub

error_handler:
MsgBox Err.Number & ": " & Err.Description
Resume leave
End Sub

Sub CopyData(wsSource As Excel.Worksheet, wbDest As Excel.Workbook, strName As String)
Dim rgFound As Excel.Range
Dim wsDest As Excel.Worksheet
Dim Rng As Excel.Range
Dim rgSource As Excel.Range
Dim rgDest As Excel.Range
Dim startrow As Long
Dim y As Long
Dim Z As Long
Dim x As Date
Dim name As String

With wsSource

Set rgFound = .Range("A1:A26").Find(What:="date", After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rgFound Is Nothing Then

startrow = rgFound.Row + 1
x = .Range("A" & startrow).Value

Set rgSource = .Range("b" & startrow, .Range("B" & startrow).End(xlDown))

name = .name & "-" & .Range("b1").Value

Set wsDest = wbDest.Sheets(strName)

With wsDest
Set Rng = .Range("A:A").Find(What:=x, _
After:=.Range("a1"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Rng Is Nothing Then
y = Rng.Row
Z = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
Set rgDest = .Cells(y, Z)
rgSource.Copy Destination:=rgDest
.Cells(1, Z).Value = name
Else
' MsgBox "Nothing found"
End If

End With ' wsDest

End If ' Not rgFound Is Nothing

End With ' wsSource

End Sub

[LucasLondon]

Thanks guys.

I have tested the last code out a few times on different datasets and it has worked fine.

L

[Bob Phillips]

That was nearly a year ago. That was some testing!