Loop macro through all columns of worksheet

Hello all

I have this code which is intended to perform a required task: build a single, 2-column list from the filtered results of one (or several worksheets) from another workbook.

The macro that I have built performs the task as required, but my code makes specific reference to the 1st column of data within the source sheet, so the macro only performs the task for the 1st column.

How can I change the code so that it repeats the process for each subsequent column across the worksheet until it reaches the end (either a blank cell in row 1 OR the end of the sheet)? I have marked the 2 sections of the code that reference a specific column using comments containing ********** and ++++++++++ respectively.

The 2nd item on my wish-list (although I will be more than happy if I can only have the above) is to then repeat the process through a further 9 specified worksheets within the same workbook as each sheet is completed (I have marked this part of the code with //////////).

I have spent a whole lot of time investigating this and experimenting and I have previous posts which were unsuccessful. I am desperately hoping that there is someone out there who can come to my rescue as my next approach is going to have to be extremely manual.

Sub FirstColumn()

'Full process is only run if Master Schedule is not open
    On Error GoTo ErrorHandler

'Request user close Master Schedule if it is open
    Windows("Master Direct Cost Schedules.xls").Activate
    MsgBox "Please close Master Direct Cost Schedules before running this update"

Exit Sub

ErrorHandler:

'Open materials schedules
    Workbooks.Open "J:\Master Direct Cost Schedules\Master Direct Cost Schedules.xls", _
        ReadOnly:=True, UpdateLinks:=False

'Select 1st sheet required
'//////////Can we change the selected sheet once process has looped through all columns??//////////
    Sheets("Consumables 1").Select

'This is the 1st column containing data.
'**********This reference needs to move across to next column with each loop**********
    Range("J1").Select
    
'This part of code to loop as it is
    Selection.Copy
    ThisWorkbook.Activate
    Range("FirstBlankAnalysis").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Master Direct Cost Schedules.xls").Activate
    
'++++++++++This reference needs to move across to next column with each loop++++++++++
    Selection.AutoFilter Field:=10, Criteria1:="<>"
    
'Balance of code to loop as it is
    Range("Offset(B4, 1, 0, 1, 1)").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ThisWorkbook.Activate
    Range("Offset(EndOflist, 1,1,1,1)").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("Offset(FirstBlankAnalysis, -1,0,1,1)").Select
    Selection.Copy
    Range("CodeRequired").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("Master Direct Cost Schedules.xls").Activate
    ActiveSheet.ShowAllData
   
'Process should revert back to section commencing with ********** comment
'until it has processed the last column containing data in row 1
'and then (if possible) it should select the next sheet to begin loop
   
   
End Sub

Any thoughts???

Hi Berries

I have no way to test it but try this code and see if it does as you described

Sub FirstColumn()
    Dim vWks As Variant
 
    'Full process is only run if Master Schedule is not open
    On Error GoTo ErrorHandler
    'Request user close Master Schedule if it is open
    Windows("Master Direct Cost Schedules.xls").Activate
    MsgBox "Please close Master Direct Cost Schedules before running this update"
    Exit Sub
ErrorHandler:
    'Open materials schedules
    Workbooks.Open "J:\Master Direct Cost Schedules\Master Direct Cost Schedules.xls", _
                   ReadOnly:=True, UpdateLinks:=False
    For Each vWks In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9")
        'Select 1st sheet required
        '//////////Can we change the selected sheet once process has looped through all columns??//////////
        Sheets(vWks).Select
        lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        colcnt = lastcol - 10
 
        'This is the 1st column containing data.
        '**********This reference needs to move across to next column with each loop**********
        Sheets(vWks).Range("J1").Select
        For I = 1 To colcnt
            'This part of code to loop as it is
            Selection.Copy
            ThisWorkbook.Activate
            Range("FirstBlankAnalysis").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Windows("Master Direct Cost Schedules.xls").Activate
            '++++++++++This reference needs to move across to next column with each loop++++++++++
            Selection.AutoFilter Field:=10, Criteria1:="<>"
            'Balance of code to loop as it is
            Range("Offset(B4, 1, 0, 1, 1)").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            ThisWorkbook.Activate
            Range("Offset(EndOflist, 1,1,1,1)").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Range("Offset(FirstBlankAnalysis, -1,0,1,1)").Select
            Selection.Copy
            Range("CodeRequired").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Windows("Master Direct Cost Schedules.xls").Activate
            ActiveSheet.ShowAllData
            'Process should revert back to section commencing with ********** comment
            'until it has processed the last column containing data in row 1
            'and then (if possible) it should select the next sheet to begin loop
        Next I
    Next vWks
End Sub

Place the names of your sheets in the array.

John

Hi Berries

It's late here tonight. I'll look at this tomorrow.

John

Although the macro could use a major rewrite to remove all the selecting and activating, addressing the commands directly to the ranges in questions, try just fixing this for now:

            LastCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1

PASSWORD protected file...

Hi Berries

I've modified the code somewhat based on the actual structure of your worksheets

Sub ForumAnswer()
    Dim vWks As Variant
    'Full process is only run if Master Schedule is not open
    On Error GoTo ErrorHandler
    'Request user close Master Schedule if it is open
    Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
    MsgBox "Please close Master Direct Cost Schedules before running this update"
    Exit Sub
ErrorHandler:
    'Open materials schedules
    Workbooks.Open "C:\Master Direct Cost Schedules (Abridged version for testing).xls", _
                   ReadOnly:=True, UpdateLinks:=False
    '    Workbooks.Open "C:\Documents and Settings\Administrator\Desktop\Berries\Master Direct Cost Schedules (Abridged version for testing).xls", _
         '                ReadOnly:=True, UpdateLinks:=False
    For Each vWks In Array("A category materials 1", "B category materials 1", "C category materials 1", _
                           "D category materials")
        'Select 1st sheet required
        '//////////Can we change the selected sheet once process has looped through all columns??//////////
        Sheets(vWks).Select
        lastcol = ActiveSheet.UsedRange.Columns.Count
        colcnt = lastcol - 9
        'This is the 1st column containing data.
        '**********This reference needs to move across to next column with each loop**********
        '        Sheets(vWks).Range("J1").Select
        For I = 10 To colcnt
            Cells(1, I).Select
            'This part of code to loop as it is
            Selection.Copy
            ThisWorkbook.Activate
            Range("Offset(LastAnalysisCode, 1,0,1,1)").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
            '++++++++++This reference needs to move across to next column with each loop++++++++++
            Selection.AutoFilter Field:=ActiveCell.Column, Criteria1:="<>"
            'Balance of code to loop as it is
            Range("Offset(B4, 1, 0, 1, 1)").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            ThisWorkbook.Activate
            Range("Offset(EndOflist, 1,1,1,1)").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Range("LastAnalysisCode").Select
            Selection.Copy
            '            Range("CodeRequired").Select
            '            ActiveSheet.Paste
            Application.CutCopyMode = False
            Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
            ActiveSheet.ShowAllData
            'Process should revert back to section commencing with ********** comment
            'until it has processed the last column containing data in row 1
            'and then (if possible) it should select the next sheet to begin loop
        Next I
    Next vWks
End Sub

A couple of things...the code assumes your data starts in Column J as you inferred in your original post. However, in the workbook you posted, data appears to start in Columns J, G and H. Is this the case or am I looking at it wrong?

Second thing...the code halts at

 '   Range("CodeRequired").Select
 '   ActiveSheet.Paste

That's why these lines are commented out. Your named range "Code Required" appears to be empty.

I'm not sure what you're trying to do here but the code does what it's written to do.

Let me know of issues.

John

99 times out of 100, this line of code will do what you want:

lastcol = ActiveSheet.UsedRange.Columns.Count

But that's not really a reliable use of UsedRange function. There's a hidden flaw most people won't run into, and when they finally do they won't understand what's gone wrong.

UsedRange.Columns.Count means "tell me how many columns have data", not "tell me what the last column is".

Using the function the way you're using it is only accidentally giving you the correct answer. More simply, if you skip any rows at the top of your worksheet or columns on the left, the code may no longer give the correct answer.

You want to see this problem in action...

1) Open a blank worksheet
2) Put some data in C3 and no where else

Now try your command code and you'll see that it reports the Last Row and/or the Last Col is 1 instead of the expected 3.

Because of this, I never rely on the USEDRANGE.COLUMNS.COUNT method.

===========
This has been a public service announcement brought to you by Calgon...."take me away"

Hi JBeaucaire

Thanks for the "slap upside the head".

I've read of the caveats using

lastcol = ActiveSheet.UsedRange.Columns.Count

and I appreciate your feedback. What I was attempting to do here was count the number of Columns on Row 1 that have data beginning in Column 10 to the right. This didn't work

LastCol = Cells(10, Columns.Count).End(xlToLeft).Column

it gave me a false answer . Also, this didn't work

LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

After a couple of hours of not being able to figure out why, I resorted the "offending" code.

You may or may not believe that I've rewritten this post because, in writing the original version, I had an "Aha" moment. "Right" vs "Left"? Sometimes I'm dyslexic like that.

Thanks again for your feedback.

John

Here are my two favorite techniques for spotting the last column accurately. The first YOU pick which row to look across, the second simply finds the last column of data by examining all columns.

#1
LastCOL = Cells(1, Columns.Count).End(xlToLeft).Column

#2
LastCOL = Cells.Find("*", Cells(Rows.Count, Columns.Count), _
   SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

John, as you guys continue to work with this macro, I believe your results will improve if you can edit out all the "selections" and simply address your commands to the rows/columns directly.

Hi Berries

Try this code; it appears to be doing as it should.

Sub ForumAnswer()
    Dim vWks As Variant
    'Full process is only run if Master Schedule is not open
    On Error GoTo ErrorHandler
    'Request user close Master Schedule if it is open
    Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
    MsgBox "Please close Master Direct Cost Schedules before running this update"
    Exit Sub
ErrorHandler:
    'Open materials schedules
    Application.ScreenUpdating = False
    Workbooks.Open "C:\Documents and Settings\tony.perry\Desktop\Master Direct Cost Schedules (Abridged version for testing).xls", _
                   ReadOnly:=True, UpdateLinks:=False
    '    Workbooks.Open "C:\Documents and Settings\Administrator\Desktop\Berries\Test macro\Master Direct Cost Schedules (Abridged version for testing).xls", _
         '                   ReadOnly:=True, UpdateLinks:=False
 
    For Each vWks In Array("A category materials 1", "B category materials 1", "C category materials 1", _
                           "D category materials")
        'Select 1st sheet required
        '//////////Can we change the selected sheet once process has looped through all columns??//////////
        Sheets(vWks).Select
        ActiveSheet.Unprotect Password:="Secret"
        lastcol = Worksheets(vWks).Range("J1:IV1").Cells.SpecialCells(xlCellTypeConstants).Count
        lastrow = Cells(65536, 2).End(xlUp).Row
        colcnt = lastcol + 10 - 1
        'This is the 1st column containing data.
        '**********This reference needs to move across to next column with each loop**********
        '        Sheets(vWks).Range("J1").Select
        For i = 10 To colcnt
            'This part of code to loop as it is
            Cells(5, i).Resize(lastrow, 1).AutoFilter Field:=1, Criteria1:="<>"
            Cells(1, i).Copy
            ThisWorkbook.Activate
            Range("Offset(LastAnalysisCode, 1,0,1,1)").PasteSpecial
            Application.CutCopyMode = False
            Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
            '++++++++++This reference needs to move across to next column with each loop++++++++++
            'Selection.AutoFilter Field:=ActiveCell.Column, Criteria1:="<>"
            'Balance of code to loop as it is
            Range("Offset(B4, 1, 0, 1, 1)").Select
            Range(Selection, Selection.End(xlDown)).Copy
            ThisWorkbook.Activate
            Range("Offset(EndOflist, 1,1,1,1)").PasteSpecial
            Range("LastAnalysisCode").Copy
            Range("CodeRequired").PasteSpecial
            Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
            ActiveSheet.AutoFilterMode = False
            'Process should revert back to section commencing with ********** comment
            'until it has processed the last column containing data in row 1
            'and then (if possible) it should select the next sheet to begin loop
        Next i
    Next vWks
    Application.ScreenUpdating = True
End Sub

Please note, I had to unprotect the sheets to make some things work. I didn't set protection back on. You may wish to do that. Let me know of issues.

John

Another option you can use instead of unprotecting a worksheet, you can update the existing protection to ADD the ability for your macro to run freely even though the sheet is protected. The UserInterfaceOnly parameter makes it so the protection only applies to humans, not to VBA.

ActiveSheet.Protect Password:="Secret", UserInterFaceOnly:=True

Use this at the top instead of unprotecting.


NOTE: The UserInterfaceOnly setting disappears when you close the workbook, it must be set at least once again when the workbook is opened again, or just include it in your macros as shown.

Hi JB

Actually, Berries has this workbook open code

Private Sub Workbook_Open()
With Sheet2
       .Protect Password:="Secret", UserInterfaceOnly:=True
       .EnableOutlining = True
 
    End With

so I'm not certain why I had issues with some of the code not executing properly. Unprotecting the worksheet fixed the problems I was having so I ran with that.

I'm fairly certain we're not done yet so I'll try to resolve the issue in the next rewrite.

Thanks for your feedback.

John

Hi Tony

I found a bit of a bug. The procedure is picking up an extra record for each sheet. I believe I know the fix. I need you to look the data over carefully and see if you find other issues.

Change this line of code

Cells(5, i).Resize(lastrow, 1).AutoFilter Field:=1, Criteria1:="<>"

to this

Cells(4, i).Resize(lastrow, 1).AutoFilter Field:=1, Criteria1:="<>"

and this should fix the bug I found.

I'm going to be traveling this week and weekend, so I may or may not get time to look at this. But get back to me with issues you see.

John

Hi Berries

I'll try to look at this in the next day or two. My children and grand children are coming to visit for the Holiday so I may not get right on it.

You might show me an example of this

have the name of the respective source worksheet pasted into the 3rd column

I'll get back to you.

John

Hi John

Column A is populated with a combination of:

Cells(1, i).Copy
            ThisWorkbook.Activate
            Range("Offset(LastAnalysisCode, 1,0,1,1)").PasteSpecial

and later:

Range("LastAnalysisCode").Copy
            Range("CodeRequired").PasteSpecial

Column B is populated with (Subject to improvement per my previous post):

Range("Offset(B4, 1, 0, 1, 1)").Select
            Range(Selection, Selection.End(xlDown)).Copy
            ThisWorkbook.Activate
            Range("Offset(EndOflist, 1,1,1,1)").PasteSpecial

What I am hoping for is a way to also have column C populated with the name of the worksheet (eg. A category materials 1 or B category materials 1) that the data in each row has originated from. The reason for this is so that I can use formulae to extract the additional information that I need from each of the relevant worksheets.

I hope that this makes sense.

Thanks John, and have a great time with your family. I will also be heading north on the weekend to see my family- they are taking me away for a couple of days so I will be offline until Tuesday night my time.

Hi Berries

See if this code solves the problem you were having and if it satisfies regarding the file name in column C

Sub ForumAnswer()
    Dim vWks As Variant
    Dim LR As Long
    'Full process is only run if Master Schedule is not open
    On Error GoTo ErrorHandler
    'Request user close Master Schedule if it is open
    Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
    MsgBox "Please close Master Direct Cost Schedules before running this update"
    Exit Sub
ErrorHandler:
    'Open materials schedules
    Application.ScreenUpdating = False
        Workbooks.Open "C:\Documents and Settings\tony.perry\Desktop\Master Direct Cost Schedules (Abridged version for testing).xls", _
                            ReadOnly:=True, UpdateLinks:=False
'    Workbooks.Open "C:\Documents and Settings\Administrator\Desktop\Berries\Test macro\Master Direct Cost Schedules (Abridged version for testing).xls", _
'                   ReadOnly:=True, UpdateLinks:=False
 
    For Each vWks In Array("A category materials 1", "B category materials 1", "C category materials 1", _
                           "D category materials")
        'Select 1st sheet required
        '//////////Can we change the selected sheet once process has looped through all columns??//////////
        Sheets(vWks).Select
        ActiveSheet.Unprotect Password:="Secret"
        lastcol = Worksheets(vWks).Range("J1:IV1").Cells.SpecialCells(xlCellTypeConstants).Count
        LastRow = Cells(65536, 2).End(xlUp).Row
        colcnt = lastcol + 10 - 1
        'This is the 1st column containing data.
        '**********This reference needs to move across to next column with each loop**********
        '        Sheets(vWks).Range("J1").Select
        For i = 10 To colcnt
            'This part of code to loop as it is
            Cells(4, i).Resize(LastRow, 1).AutoFilter Field:=1, Criteria1:="<>"
            LR = Range("B" & Rows.Count).End(xlUp).Row
            If LR = 4 Then
                MsgBox "You have no Data in Column" & i
            Else
                Cells(1, i).Copy
                x = ActiveSheet.Name
                ThisWorkbook.Activate
                Range("Offset(LastAnalysisCode, 1,0,1,1)").PasteSpecial
                ActiveCell.Offset(0, 2).Value = x
                Application.CutCopyMode = False
                Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
                '++++++++++This reference needs to move across to next column with each loop++++++++++
                'Selection.AutoFilter Field:=ActiveCell.Column, Criteria1:="<>"
                'Balance of code to loop as it is
                Range("B5:B" & LR).Copy
                ThisWorkbook.Activate
                Range("Offset(EndOflist, 1,1,1,1)").PasteSpecial
                Range("LastAnalysisCode").Copy
                Range("CodeRequired").PasteSpecial
            End If
            Windows("Master Direct Cost Schedules (Abridged version for testing).xls").Activate
            ActiveSheet.AutoFilterMode = False
            'Process should revert back to section commencing with ********** comment
            'until it has processed the last column containing data in row 1
            'and then (if possible) it should select the next sheet to begin loop
        Next i
    Next vWks
    ThisWorkbook.Activate
    Call FillColBlanks_Offset
    Application.ScreenUpdating = True
End Sub

Sub FillColBlanks_Offset()
'by Rick Rothstein  2009-10-24
'fill blank cells in column with value above
'http://www.contextures.com/xlDataEntry02.html
    Dim Area As Range, LastRow As Long
    On Error Resume Next
    LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
                         SearchDirection:=xlPrevious, _
                         LookIn:=xlFormulas).Row
    For Each Area In ActiveCell.EntireColumn(3).Resize(LastRow). _
        SpecialCells(xlCellTypeBlanks).Areas
        Area.Value = Area(1).Offset(-1).Value
    Next
End Sub

Let me know of issues.

John

Originally Posted by snb

Avoid using select and activate in VBA-code.

Agreed.

Originally Posted by snb

Use Usedrange to determine the number of used columns/rows.

I can never recommend this technique. There is a hidden flaw in the UsedRange method that will eventually bite you.

To see the flaw in action, open a new workbook, put a value in cell F5 only, then try your UsedRange technique to get the LastRow with data, you will get an answer of 1 instead of 5. This means your macro can be failing and you don't even know it.

Simplest way to always get the last row is to examine the column in question specifically, or do a generic "search all rows for the last row of data"...here are the two I always use now:

'Check all rows
LastRow = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row

'Check one column specifically
LastRow = Range("A" & Rows.Count).End(xlUp).Row

Originally Posted by snb

Use specialcells(2) to identify cells with values in it.

If you want people to have no clue what your code is doing at this point, use SpecialCells(2). If you want them to at least be able to read it the first time through without wondering, use SpecialCells(xlConstants).

There are a LOT of shortcuts to make code take fewer letters and people use them, but they typically make the code a LOT more difficult to understand. Since this is a teaching forum, I use them less and less every day.

Originally Posted by snb

I think you don't need autofilter.

AutoFilter is almost always faster at collecting data than going row by row or cell by cell.

Originally Posted by snb

Most of the time 'copying' values can be done more easily (and faster)
with e.g. range("K2")=range("B7"). (to copy cell B7 to cell K2)

Absolutely.

Hi Berries
Regarding this

Application.CutCopyMode = False

the line of code clears the clipboard of data. I've always been of the impression that you only needed the line of code once in the procedure to clear the clipboard; however, since you asked the question, I researched it further and can no longer find that reference. In fact, most advise that you include the line of code after each copy/paste action.

Glad the code works for you. Thanks for the "Style" points.

John