using the * as a wildcard? (excel)

[bluerayz]

Hello,
I am trying to filter out excel files from a folder. The excel files in the folders are filtered by looking in a cell and if the value in that cell matches a case in the macro, then the folder is copied and pasted into anther folder. Unfortunetly the values in the cell which determines if the folder is copied are name multiple names. all Values though have the name CleanTech in them. So I am trying to figure out if I could use "*CleanTech*" to help me find all the correct excel files. I though since it works in Access it might work in my excel vba?

heres the peice of code im playing with

For Each sfl In fld.SubFolders
For Each fil In sfl.Files
fCopy = False
If Right(fil.Name, 4) = ".xls" Then
Set wbk = Workbooks.Open(Filename:=strSource & sfl.Name & "" & fil.Name, AddToMRU:=False)
'Search the worksheet and cell for case
Select Case wbk.Worksheets(1).Range("C14")
'Enter the job names suitable for moving. ex. "cleantech","WaterFoam", .....
Case "*CleanTech*"
'Case "CleanTech", "Foamed CleanTech", "Foamed", "Foam", "CleanTech Foam", " Foamed CleanTech"
fCopy = True
End Select
wbk.Close SaveChanges:=False
Exit For
End If
Next fil
If fCopy Then
'below copies and paste to folder
sfl.Copy strTarget
'below cuts and paste the folder to the target folder
'sfl.Move strTarget & sfl.Name

End If

[HansV]

You can't use wildcards this way in a Case statement. There are several alternatives:

1) Use the Like operator:

If wbk.Worksheets(1).Range("C14") Like "*CleanTech*" Then
...
End If

2) Use the InStr operator. InStr(FindIn, What) returns the first position where What is found within FindIn, or 0 if What doesn't occur.

If InStr(wbk.Worksheets(1).Range("C14"), "CleanTech") > 0 Then
...
End If

[bluerayz]

where can I add one of those lines?

[HansV]

They should replace

Select Case wbk.Worksheets(1).Range("C14")
Case ...
...
End Select

[bluerayz]

Ok thanks Hans,
One question. After the code moves in to your line "If InStr(wbk.Worksheets(1).Range("C14"), "CleanTech") > 0 Then "
it goes to the next commanf fcopy=true

is this enough to allow the macro to run, I am getting an erro on the for loop.


Sub Part1()
Dim fso As Object
Dim fld As Object
Dim sfl As Object
Dim fil As Object
Dim strSource As String
Dim strFile As String
Dim strTarget As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim fCopy As Boolean

On Error GoTo ErrHandler
Application.ScreenUpdating = False

Set wsh = ThisWorkbook.Worksheets(1)
'Look in this directory path to find JOBS
strSource = wsh.Range("F1")
If Not Right(strSource, 1) = "" Then strSource = strSource & ""
'files which fit cases will be moved here
strTarget = wsh.Range("F2")
If Not Right(strTarget, 1) = "" Then strTarget = strTarget & ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strSource)
For Each sfl In fld.SubFolders
For Each fil In sfl.Files
fCopy = False
If Right(fil.Name, 4) = ".xls" Then

Set wbk = Workbooks.Open(Filename:=strSource & sfl.Name & "" & fil.Name, AddToMRU:=False)

If InStr(wbk.Worksheets(1).Range("C14"), "CleanTech") > 0 Then

fCopy = True

wbk.Close SaveChanges:=False
Exit For
End If
Next fil
If fCopy Then
'below copies and paste to folder
sfl.Copy strTarget
'below cuts and paste the folder to the target folder
'sfl.Move strTarget & sfl.Name

End If
Next sfl

[HansV]

You're missing an end if. Try this as central part:

For Each sfl In fld.SubFolders
For Each fil In sfl.Files
fCopy = False
If Right(fil.Name, 4) = ".xls" Then
Set wbk = Workbooks.Open(Filename:=strSource & _
sfl.Name & "" & fil.Name, AddToMRU:=False)
If InStr(wbk.Worksheets(1).Range("C14"), "CleanTech") > 0 Then
fCopy = True
wbk.Close SaveChanges:=False
Exit For
End If
wbk.Close SaveChanges:=False
End If
Next fil
If fCopy Then
'below copies and paste to folder
sfl.Copy strTarget
'below cuts and paste the folder to the target folder
'sfl.Move strTarget & sfl.Name
End If
Next sfl

[bluerayz]

Thank you very much