Loop macro for all Excel files in folder

thank you for your timely response! All the files have .xlsx extensions. There's about 2000 of them. However, the code for clearing the cell to the right of the cell including the text "Approximate # of persons covered at end of policy or contract year" will not work if there is other content in that cell. Sometimes there are other letters, symbols, or dotted leaders but that text string is always the same. Any ideas on how to overcome that hurdle would be much appreciated.

Couple questions:

• Does each file only have a single sheet named Sheet1? If there are multiple sheets per file do you need to check every sheet?
• Are the workbooks you need to check all in the same parent folder? If so are there any subfolders we need to look in too?
• You mention the things you are looking for are not always in the same sheet column, but do they always have the same header? (IE: might the dates column have the word "Date" always on x row above the dates)

Couple recommendations:

• I would do this in such a way that you have an output folder and copy each file, make your changes, save it to output folder (so that you have originals in case something doesnt work or you need to check anything later).
• I would provide a warning dialog prior to running to let the user know this may take a long time and allow them to either continue or cancel (as Excel will be tid up until the macro completes).

Couple things I notice with the code as is (and it would change drastically if you need to apply it to many files, as you will be looping and wont be hardcoding things like Activeworkbook).

rng is set to A1:Z1000. Does each sheet have content in that range? Is there ever more content or is that beyond the max expected? If your sheets never have that much content then you are much better off going with UsedRange. This way you ensure you always get/evaluate all the used cells on a sheet and nothing more (which can waste time).

As mentioned you can use InStr() to check for a phrase.

Looping cells is very slow. Especially when you do it 2 times instead of a single time. You may be able to skip the loop in some places or reduce the number of cells you need to loop (IE: unless dates on a single sheet are spread out willy nilly you may be able to find the first, then only loop down the rows in that column for example).

EDIT: can you post a sample file that we can check out and try things on to help you?

Originally Posted by akenney151

The files have sensitive information on them, so unfortunately I won't be able to help you out there.

You could still make some sample files without the sensitive info in it? Primarily so we have an idea of the structure of your data, not the data itself. Things like where you have headers, patterns in the file we can use for the code, etc.

As you mentioned, with only ~2 date values its a bit silly to loop every single cell looking for dates. You may instead consider using the range.find method or something like it, hard to say without a sample.

UsedRange is the range of cells Excel considers to be "in use" on a given sheet. In other words the usedrange should end at the last row and column you have actual content in on the sheet. You even use it once in your own code:

For Each c In ActiveSheet.UsedRange.Offset(1)

Used range is likely better than using a static range like A1:Z1000 as for each file/sheet used range will be exactly the range of cells and no more. So if a sheet really only has content on A1:Z100 you are checking 2600 cells more than you need to using a static range. If another sheet has content A1:ZZ20000 then you are missing most of the data using a static range.

To manually check the used range on a sheet select A1 and on the keyboard do Ctrl+Shift+End. What is selected is the used range on that sheet (so you have an idea of what used range means).

Tabular information tends to have headers in the column with each row being a record in the data set (presuming the data is tabular). Is there a row of headers in these files? Can we use those headers to find columns like a date column?

@xladept code will get you closer in that it will loop files, but it doesn't address some of the issues I mentioned in my prior post. For example you loop all the cells in the range using a For each loop and then do it a 2nd time instead of handling actions on the cells all in one For loop. Thats double the work for each file x2000 files.

This is untested - your code is between the commented asterisks - it saves changes, so take care:

Sub akenney(): Dim wb As Workbook, ws As Worksheet, rng As Range
Dim CCell As Range, ReplaceRange As Range, c As Range
Dim S As String, P As String, U As String
P = ActiveWorkbook.Path: P = P & "\": U = Dir(P): S = P & U

GetBook:
            If U Like "*xlsx*" Then
                Workbooks.Open P & U, 0
'****************************your code************************************
                Set wb = ActiveWorkbook
                Set ws = wb.Sheets("Sheet1")
                Set rng = ws.Range("A1:Z1000")
                    For Each Cell In rng.Cells
    If IsDate(Cell.Value) Then Cell.Value = DateAdd("yyyy", 1, Cell.Value)
                    Next Cell
    
                    For Each CCell In rng.Cells
If Replace(CCell.NumberFormat, "$", "") <> CCell.NumberFormat Then CCell.ClearContents
    If Replace(CCell.Value, "$", "") <> CCell.Value Then CCell.ClearContents
                    Next CCell
    
            For Each c In ActiveSheet.UsedRange.Offset(1)
If InStr(c.Value, "Approximate # of persons covered at end of policy or contract year") _
                          Then c.Offset(0, 1).ClearContents
             Next c
'***********************************************************************************
            wb.Close True: End If
            
GetNextBook:  U = Dir()
If U <> "" Then GoTo GetBook
End Sub

It runs on my system if I Change Cell to c in your code i.e.

Sub akenney(): Dim wb As Workbook, ws As Worksheet, rng As Range
Dim CCell As Range, ReplaceRange As Range, c As Range
Dim S As String, P As String, U As String
P = ActiveWorkbook.Path: P = P & "\": U = Dir(P): S = P & U

GetBook:
            If U Like "*xlsx*" Then
                Workbooks.Open P & U, 0
'****************************your code************************************
                Set wb = ActiveWorkbook
                Set ws = wb.Sheets("Sheet1")
                Set rng = ws.Range("A1:Z1000")
                    For Each c In rng
    If IsDate(c.Value) Then c.Value = DateAdd("yyyy", 1, c.Value)
                    Next c
    
                    For Each CCell In rng.Cells
If Replace(CCell.NumberFormat, "$", "") <> CCell.NumberFormat Then CCell.ClearContents
    If Replace(CCell.Value, "$", "") <> CCell.Value Then CCell.ClearContents
                    Next CCell
    
            For Each c In ActiveSheet.UsedRange.Offset(1)
If InStr(c.Value, "Approximate # of persons covered at end of policy or contract year") _
                    Then c.Offset(0, 1).ClearContents
            Next c
'***********************************************************************************
            wb.Close True: End If
            
GetNextBook:  U = Dir()
If U <> "" Then GoTo GetBook
End Sub

Merged Cells can be a problem lest they're all merged the same way - we can unmerge them??

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

You're welcome and thanks for the rep!

BTW - Running "Option Explicit" is something you should do

Ok so a couple observations I can make now that I have seen some samples.

Your data is arranged like a form, with labels to the left and data to the right (I know you explained it as such, but seeing it shows us this doesnt vary).

Knowing you have labels, can we make any assumptions about what the labels will be across the 2000 files? IE: will there always be a label towards the top of the sheet that says "For Year:"? Will the dates you want to change always have the same labels?

Lets assume your sheet(s) have 100 used cells in column A and B. Looping each cell just to find 5-6 values only makes sense when those 5-6 values can be in any of those cells. If, however, we can find those values according to a unique entry/label then there are ways to find just those things very quickly by comparison.

For example, I wouldnt loop all your cells to find "For Year:" presuming that label is the same in all of your files. Instead I would use range.find which will return the range object of that cell (ex: A2). I could then simply offset 1 column to the right of it and set the .value of the range as desired (2017).

So the big question is, can we look for specific labels to make changes or are they not consistent enough (a couple variations on the labels is ok, 100 different variations on a single label...too much to be feasible)?

If you are not sure, spot check your files. Open a couple from more recent, a couple a bit older, a couple a bit older than that, etc. See if you notice any change in patterns like vastly different labels or layout.

This is also why I recommend either making copies of them and using the copies or having the macro leave the originals and make copies...so that going back you can account for any missing labels or any labels you didnt want to change but that got changed due to an unexpected match to your conditions.

Let me know if you think using the labels is a viable approach to finding the content you want to change.

Also is this 1 and done (ie: change the 2000x files and never do this again) or is this something you will need to repeat again at some point? Where do these files come from? May be worth considering standardizing the files (maybe be possible to automate some of the changes, especially the dates).

Still, I would need a sample worksheet with all idiosyncrasies.

Anyway, thanks for the rep!

Based on your samples and description in post #18 it seems like:

• You have at least 2 variations on the layout
• Much of what you need to find can be identified by a label
• Once the label is found, the value to change should be the cell to the right of it
• The only change I see that cant be found via label is the dollar amounts.

So with that in mind, I think we would need to:

1. Identify how many "types" of layouts there are, have the macro identify which a given file is to apply the proper logic to it
2. Either have the macro make copies of the modified files to a specific directory or assume we are working from copies
3. Come up with a list of specific labels and if they are unique to a specific layout or universal across all the files to check.
4. As you have mentioned, somehow log exceptions. Maybe generate a txt or Excel file listing information like ex: File name/path, label(s) missed.

Originally Posted by akenney151

The labels I mentioned before - For Year, Plan Year Beginning/Ending, and Approximate # .... - should be universal across all forms.

In the 4 files you posted however, "For Year" is not in #1 samples for example. Is that not a correct representation of your actual files then? It is safe to work on the notion that they all share those labels? If so should we base or testing on the Test 2 Before sample?

I am not too worried about the merged cells. Also the position of the labels isnt a big deal, as long as the label itself is consistently the same text (at least partially) then finding them without looping all cells is easy.

Ill see what I can draft up. Unless I find a really easy way to log the exceptions, I may leave that part up to you.

EDIT: just noticed the Test 2 Before file has rows 23-24 a label as just "label" with a date to the right. So to clarify what labels do we need to find to adjust dates (excluding the From year label)?

• Plan Year Beginning
• Plan Year Ending

Are there any other labels representative of a date in the file? Can a label be repeated multiple times in the same file and if so do we act on all of them then?

I noticed some of the cells with currency format have formulas in them, in that case do you still want to delete the contents of the cell (formula included), clear the formatting or ignore those cells?

I have by the way already written the code to handle everything but the currency formats, including clearing merged cells. I made 4 copies of your before 2 file and adjusted values in each one. Macro takes a split second to complete. Ill post it when complete.

EDIT: Also, do you want to clear only the contents of the currency cells or remove the currency format as well?

This seems to work:

Sub akenney(): Dim wb As Workbook, ws As Worksheet, r As Long
Dim S As String, P As String, U As String
P = ActiveWorkbook.Path: P = P & "\": U = Dir(P): S = P & U

GetBook:
            If U Like "*xlsx*" Then
                Workbooks.Open P & U, 0

                Set wb = ActiveWorkbook
                Set ws = wb.Sheets("Sheet1")
                ws.Cells(2, 2).Value = ws.Cells(2, 2).Value + 1
                For r = 3 To ws.Range("B" & Rows.count).End(xlUp).Row
                    
                If IsDate(ws.Cells(r, 2)) Then
            ws.Cells(r, 2).Value = DateAdd("yyyy", 1, ws.Cells(r, 2).Value)
                ElseIf IsNumeric(ws.Cells(r, 2)) Then
                    Select Case ws.Cells(r - 1, 1)
                    Case "Name", "Number"
                    Case Else: ws.Cells(r, 2) = "": End Select
                    End If: Next r    

            wb.Close True: End If
            
GetNextBook:  U = Dir()
If U <> "" Then GoTo GetBook
End Sub

See attached. I have zipped the file with the macro in it and a folder of the before and after results.

You will need to change 2 constants in the macro prior to using it. The constant for source folder and for destination folder. These are at the top of the module and all code is clearly commented.

The macro loops the files in a source folder, modifies them as follows:

• Find the label for your dates, change the cell to the right +1 year
• Find the label for "For Year" and increase the cell to the right by 1
• Find the long "Aprox..." string and clear the cell to the right.
• Find all cells formatted as currency and clear contents (currently regardless of static/formula and currently doesnt clear currency formatting from cell)

It saves them to an output folder specified in constants.

I even managed to slip some logging into my error checker, but its very basic and just outputs to the immediate window.

I made some assumptions in the macro:

• All the files you want to modify are in the same source folder with no other files in the folder
• You will have created a folder to place the resulting modified files into prior to running the macro
• You have updated the constants for source and destination folder to match your setup
• The source files all follow the same pattern we discussed and hopefully I understood it correctly
• Both speed and readability are important. (important for it to work quick but also important for you to be able to follow why it works)

Test it out, let me know if you have questions.

Ok cool, it currently clears the formula and contents, not the formatting (ie if you typed a number back in the cell itd be currency).

Test the file i posted and if you like it we can tweak it as needed.

Originally Posted by akenney151

@Zer0cool - your macro was huge and intimidating with all the comments but it successfully loops through all the files in the folder and places the updated workbooks in the output folder. It also runs pretty fast, and all the changes were made correctly. Somehow it didn't even care that there were some numbers separated by commas and just left those alone. So.... it works perfectly .

Glad to hear its working. The macro is longer than it seems because I over commented it so you could follow the logic, but in the hopes that the way I wrote the macro and comments would be efficient AND easy for a person to read. I also tend to be very explicit in my declarations and constants, which adds some heft to it initially but makes it easier to update and scale.

For example, lets say you have an additional label to check for in the future, lets say the label is "OMG Zer0Cool is Awesome" (haha). You would not have to change the structure of my macro much. You add that string to the constant of strings comma delimited and expand the if statement according to the action to take. The loop itself should work with it, no need to worry about the method not working if you need to expand on it. The same is true for currency formats. Lets say you find across the 2000 files that 3 different currency formats have been used, then you just add the additional ones to the formats constant, pipe "|" delimited and your done, all 3 types of currency format are cleared. Easy.

Also in testing I would imagine you are using a small subset of files and not close to 2,000. I have a feeling my macro should be as fast as can possibly be. Lets say its .5 seconds faster per file than other methods provided, across 2000 files that should save you roughly 16 minutes of time (unless im too tired for math, 1000 seconds = ~16 mins?).

My approach does not loop cells, which is generally slow. Instead I am using the built in Find and Replace functions of Excel which should be significantly faster, especially in larger ranges. In my macro I am actually looping the terms/labels you want to find and the currency format(s) you want to find which should make it easier to update the macro for new terms/formats should you need to.

Lastly, I also added error handling. I do this in every macro I write as a user should never be presented with a debug option. They should also get a clear message as to why something didn't work. As part of my error handler I have it log the file name, label that couldn't be found and error into the immediate window (could be expanded to dump into Excel or a text file).

If you have any questions about the code let me know.

I'm also glad that you're satisfied - and, thanks for the rep!

I noticed the For Year date was cleared and replaced with a 1 in the cell right above it.

That means that the starting row is one below the sample.

Do you intend to keep the Sheet Protection, IE unlock the sheet, make changes, relock it or do you want to remove sheet protection so the results are no longer protected?

Also from your snippet I am presuming you:

1. Know the password
2. The password is the same for all sheets

Is that correct?

If you want to keep the protection, you know the password and its the same for all sheets then your method is the best way to handle it.

Essentially get the file, open it, unprotect sheet, do stuff, reprotect, close file, next. It could be incorporated into my File looping routine in the macro I provided pretty easily.

However, if you do not want to keep protection and/or if the password varies or you may not know the password then the best method is to simply strip out the Sheetprotection via XML (presuming all the files are OpenXML format, xlsx, xlsm).

The reason for this is starting in Excel 2013 (afaik) MS increased the complexity of the hashing algorithm used to protect and unprotect sheets (link here). In manual use there is no noticeable impact on the end user but when combined in a macro across 100's or 1,000's of sheets it can add a very measurable difference in the time it takes to do. Despite this, they still do nothing to protect the underlying XML, so I found there is no such penalty for simply stripping out the XML in the file structure that tells it the sheets protected. This is a more complex approach to doing it and may be overkill for what you need anyhow. In addition, I am not comfortable sharing my code to do this in case it was used for malicious purposes.

I think the change to the stronger hashing adds about ~1/10th of a second per hash vs the pre 2013 hashing if I recall. Nominal for 1 or 2 sheets, seconds or minutes more for thousands of sheets.

Ok so then what you have is basically what you want. Your code removed the protection but did not re-add it. Actually benefits you as its 1 hit vs 2 for each sheet. If you like ill update the macro I gave you and attach it

Updated file, now with 100% more sheet unprotecting!

Basically added constant at top for the password (change as needed) and an if statement in the GetFiles routine. It checks if the sheet is protected, if so it attempts unprotecting with the password constant.

I have not tested the code myself, so certainly test it to ensure it works. I also have not added any error handler to specifically address if any sheet cannot be unlocked.

Also, an alternative method to this would be to use:

Sheet.protect Password:="pw", UserInterFaceOnly:=True

This essentially lets VBA mess with the sheet without unlocking but keeps the sheet locked for the user. Only beneficial if you want to keep protection.

This should run more quickly:

Sub akenneyQ(): Dim wb As Workbook, ws As Worksheet, r As Long

Dim S As String, P As String, U As String, Q
P = ActiveWorkbook.Path: P = P & "\": U = Dir(P): S = P & U

GetBook:
            If U Like "*xlsx*" Then
                Workbooks.Open P & U, 0

                Set wb = ActiveWorkbook
                Set ws = wb.Sheets("Sheet1")
                ws.Unprotect "schedulea": Q = ws.UsedRange
                
                For r = 2 To UBound(Q)
                
         If Q(r, 1) = "For Year:" Then _
            Q(r, 2) = Q(r, 2) + 1: r = r + 1
                
                If IsDate(Q(r, 2)) Then
            Q(r, 2) = DateAdd("yyyy", 1, Q(r, 2))
                ElseIf IsNumeric(Replace(Q(r, 2), ",", "")) Then
                    Select Case Q(r - 1, 1)
                    Case "Name", "Number"
                    Case Else: Q(r, 2) = "": End Select
                    End If: Next r
                    ws.Cells(1, 1).Resize(UBound(Q, 1), UBound(Q, 2)) = Q
    
            wb.Close True: End If
            
GetNextBook:  U = Dir()
If U <> "" Then GoTo GetBook
End Sub