Look for anything other than specific characters in a column, make a list of a filename for this condition

B

boolok2011

New Member
Joined
Mar 31, 2011
Messages
13
I have 254 excel files in a folder. I need to return a list of files in which column AE has something other than the following characters: 1, 2, 3, 4, 5, 2f, -2f, 2h, -2h.

If possible, it would be good if the Macro can read files in a folder and can read the end of column automatically.

Please help. Thx ahead.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
For each file in the specified folder, the following macro opens the file, and searches Column AE of the active sheet for a value other than the specified values. If found, the name of the file is listed in Column A of the destination worksheet. When the search is complete is closes the opened file without saving it.

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wkbOpen [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksOpen [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] rCell [color=darkblue]As[/color] Range
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] wksDest = ActiveWorkbook.ActiveSheet
    
    [color=green]'Change the path accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop\Test\"
    
    [color=darkblue]If[/color] Right(strPath, 1) <> "\" [color=darkblue]Then[/color] strPath = strPath & "\"
    
    [color=green]'Change the file extension accordingly[/color]
    strFile = Dir(strPath & "*.xls")
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        [color=darkblue]Set[/color] wkbOpen = Workbooks.Open(strPath & strFile)
        [color=darkblue]Set[/color] wksOpen = wkbOpen.ActiveSheet
        [color=darkblue]For[/color] [color=darkblue]Each[/color] rCell [color=darkblue]In[/color] Intersect(wksOpen.UsedRange, wksOpen.Columns("AE"))
            [color=darkblue]Select[/color] [color=darkblue]Case[/color] rCell
                [color=darkblue]Case[/color] "", 1, 2, 3, 4, 5, "2f", "-2f", "2h", "-2h"
                    [color=green]'Do nothing[/color]
                [color=darkblue]Case[/color] [color=darkblue]Else[/color]
                    wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1).Value = wkbOpen.Name
                    [color=darkblue]Exit[/color] [color=darkblue]For[/color]
            [color=darkblue]End[/color] [color=darkblue]Select[/color]
        [color=darkblue]Next[/color] rCell
        wkbOpen.Close savechanges:=[color=darkblue]False[/color]
        strFile = Dir
    [color=darkblue]Loop[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
                
    MsgBox "Completed...", vbInformation
        
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

If Column AE for each of the files is located in the first sheet of the file, replace...

Code: 
Set wksOpen = wkbOpen.ActiveSheet

with

Code: 
Set wksOpen = wkbOpen.Worksheets(1)

If Column AE for each of the files is located on a specific named sheet, let's say Sheet1, replace...

Code: 
Set wksOpen = wkbOpen.ActiveSheet

with

Code: 
Set wksOpen = wkbOpen.Worksheets("Sheet1")
 
Upvote 0
Thx 4 your help.

I have made a minor mistake at the description. I want to search the column AW (not AE) starting from row 5 to the end of the row since the data is started at row 5.

Please help again.
 
Upvote 0
Try...

Code: 
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wkbOpen [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksOpen [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] rSearchRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] rCell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] wksDest = ActiveWorkbook.ActiveSheet
    
    [color=green]'Change the path accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop\Test\"
    
    [color=darkblue]If[/color] Right(strPath, 1) <> "\" [color=darkblue]Then[/color] strPath = strPath & "\"
    
    [color=green]'Change the file extension accordingly[/color]
    strFile = Dir(strPath & "*.xls")
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        [color=darkblue]Set[/color] wkbOpen = Workbooks.Open(strPath & strFile)
        [color=darkblue]Set[/color] wksOpen = wkbOpen.ActiveSheet
        [color=darkblue]With[/color] wksOpen
            LastRow = .Cells(.Rows.Count, "AW").End(xlUp).Row
            [color=darkblue]If[/color] LastRow >= 5 [color=darkblue]Then[/color]
                [color=darkblue]Set[/color] rSearchRng = .Range("AW5:AW" & LastRow)
                [color=darkblue]For[/color] [color=darkblue]Each[/color] rCell [color=darkblue]In[/color] rSearchRng
                    [color=darkblue]Select[/color] [color=darkblue]Case[/color] rCell
                        [color=darkblue]Case[/color] "", 1, 2, 3, 4, 5, "2f", "-2f", "2h", "-2h"
                            [color=green]'Do nothing[/color]
                        [color=darkblue]Case[/color] [color=darkblue]Else[/color]
                            wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Offset(1).Value = wkbOpen.Name
                            [color=darkblue]Exit[/color] [color=darkblue]For[/color]
                    [color=darkblue]End[/color] [color=darkblue]Select[/color]
                [color=darkblue]Next[/color] rCell
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        wkbOpen.Close savechanges:=[color=darkblue]False[/color]
        strFile = Dir
    [color=darkblue]Loop[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
                
    MsgBox "Completed...", vbInformation
        
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
Thx for your help. I really like your idea of using rsearch range and case function. It is a good code indeed. I want to modify your script so that I can do the following, please help:

Procedures:

1. The column AW starting at row 5 (AW5) can consist of values: 0,1,3,4,5,2f,2h,-2f,2h

2. Go down to seek value 4 or 5. This sets the range for analysis.

3. Within the above range, depends on which case below, then fill in the char I, M, or F

Case 1: Does not have any 3 between the range(s), then autofill from BJ5 with char "I" , for example:

colAW colBJ
row5 2h I
row6 1 I
row7 1 I
row8 1 I
row9 5 I
------------------------------
row10 0 I
row11 1 I
row12 -2h I
row13 4 I

Case 2:
Only have one 3 within the range(s) bounded by 4 or 5, then autofill the 1st range with I, and the last range with F, for example:

colAW colBJ
row5 -2f I
row6 1 I
row7 1 I
row8 1 I
row9 1 I
row10 3 I
---------------------
row11 1 F
row12 2h F
row13 -2f F
row14 5 F


Case 3: Have two 3s within the range(s) bounded by 4 or 5, then autofill the 1st with I, 2nd set with M, and the last set with F, for example:

colAW colBJ
row5 0 I
row6 1 I
row7 3 I
----------------------
row8 1 M
row9 -2f M
row10 0 M
row11 3 M
----------------------
row12 2h F
row13 -2f F
row14 5 F

Case 4:
Have three or more 3s within the range(s) bounded by 4 or 5, then autofill the 1st with I, 2nd set with M, 3rd set with M, n set with M, and the last set with F, for example:

colAW colBJ
row5 0 I
row6 1 I
row7 3 I
----------------------
row8 1 M
row9 -2f M
row10 0 M
row11 3 M
----------------------
row12 3 M
----------------------
row13 1 M
row14 -2h M
row15 1 M
row16 3 M
----------------------
row12 2h F
row13 -2f F
row14 4 F
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
O
  • Solved
Searching for unusual characters
2 3
Replies
22
Views
1K
Cubist
Cubist
B
  • Solved
Macro to open other Excel files, run a specific Macro, and close?
Replies
2
Views
642
Bret1
B
P
  • Question Question
TypeScript (or other solutions) for modifying given list of cells (and similar problems)
Replies
0
Views
254
Pingaware
P
A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
614
Amo840812
A

Forum statistics

Threads
1,224,586
Messages
6,179,730
Members
452,939
Latest member
WCrawford

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