PDA

View Full Version : Looping Through Worksheets



DLStryker
03-01-2016, 08:18 AM
I just spent 4 hours copy and pasting data from multiple worksheets in a workbook to a blank worksheet. Can someone help me with the code to loop through all of the worksheets in a workbook and in doing so, copy certain cell contents into my blank worksheet? I cannot write VBA code. I can take previously written code and adjust it for my specific needs though. Would anyone be willing to help?? I can provide you more specifics. I have researched “Looping through Worksheets”, but just cannot get it.

Thanks
Dave

Paul_Hossler
03-01-2016, 09:19 AM
This might get you started



Option Explicit

Sub CopyData()
Dim ws As Worksheet


For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name = "Destination" Then GoTo GetNextSheet
If .Visible <> xlSheetVisible Then GoTo GetNextSheet
If .ProtectContents Then GoTo GetNextSheet

.Range("A1:Z26").Copy Worksheets("Destination").Cells(1, 1)
End With

GetNextSheet:
Next
End Sub

jolivanes
03-01-2016, 05:40 PM
You might want to change

.Range("A1:Z26").Copy Worksheets("Destination").Cells(1, 1)
to something like

.Range("A1:Z26").Copy Worksheets("Destination").Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1)

DLStryker
03-02-2016, 08:02 AM
Paul_Hossler - jolivanes, thank you so much for your help. What I have is a workbook with many worksheets. The data is in the same location on each worksheet. Just different dollars amount and each worksheet represents a different cost center. What I would like to have is for a macro to go to the first worksheet, select specific cells of data and copy that data into a blank worksheet. For example, I would like the data block created to look like.



Cost Center
Revenue
Expense
Net Income
<<This is just some column headings


AB4568
150
120
30
<<This is four fields of data from the first worksheet


AC4568
140
120
20
<<This is four fields of data from the second worksheet



Can you attach Excel spreadsheets to posts in this forum?

Regards,
Dave

DLStryker
03-02-2016, 08:22 AM
You might want to change

.Range("A1:Z26").Copy Worksheets("Destination").Cells(1, 1)
to something like

.Range("A1:Z26").Copy Worksheets("Destination").Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1)


Very helpful! The data was being written on top of itself without that change in code.

Paul_Hossler
03-02-2016, 09:32 AM
I can take previously written code and adjust it for my specific needs though

Since you didn't say where you wanted to copy the data, AND that you could adjust it for your specific needs, I left that part as a homework assignment

jolivanes
03-02-2016, 09:34 AM
Is all that information, Cost Center, Revenue, Expense, Net Income, in consecutive cells? What is the range?
If not, what are the cell addresses you want to copy across?
Are the sheet names the cost center names by any chance?
Before pasting into the "collector" sheet, does it need to be cleared?

To attach a workbook, click on "Go Advanced" at the bottom right hand site and follow info.
At the top is a FAQ site also.

Paul_Hossler
03-02-2016, 09:37 AM
Can you attach Excel spreadsheets to posts in this forum?


Yep, at the bottom right of the post box (i.e. where you type -- don't know what it's really called) there's [Go Advanced] which give you more options

Use the paperclip icon

It helps if your sample WB has the 'as is' and the 'to be' included, along with any business rules and restrictions


15518

DLStryker
03-02-2016, 10:26 AM
OK. I think I have the sample file attached. I think it will be self explanatory when you view the file.

Looking to take data from specific cells on a tab, input that data into the "Destination" tab and then do that some process again for all tabs in the workbook.

Thanks!!!

DLStryker
03-02-2016, 10:45 AM
Attached is a file with code that does something similar. This code opens a workbook on a shared drive, copies the data from certain cells into a blank worksheet, then it does the same thing for the next workbook in the shared drive and copies that data one line below the previous.

I have been able to adjust this code to refer to different workbooks in different paths in the shared drive and to also collect different data from each worksheet.

BUT, that's about the extent of my VBA knowledge!! :banghead:

Thanks again!!!

jolivanes
03-02-2016, 11:54 AM
Is this a beginning for you?

DLStryker
03-02-2016, 12:12 PM
Is this a beginning for you?

A beginning to use VBA?? Not sure what you are asking.

DLStryker
03-02-2016, 12:34 PM
Is this a beginning for you?

AWESOME!!!! jolivanes!! This will save me hours of copying and pasting!! And I mean HOURS! I am working for a small company that has no financial database. I am basically building financial reports off of financial reports. very inefficient, but no other option.

Now I am going to go play with your code to understand what does what. Then I'll make adjustments to have the code pull additional data fields.

Thank you very much!!

DLStryker
03-02-2016, 01:11 PM
OK. I added additional worksheets to the workbook. The code collects the data as expected, but stops after the 8th worksheet. Then I get a VBA error pop up.
15525

I have attached the file with the additional worksheets that is getting the error code.

Many thanks!

jolivanes
03-02-2016, 01:13 PM
There are lots of different ways of doing it. I just used formulae here like you would if you did it manually.
I'll see later to do it a different way. I am curious about how fast/slow it is with the amount of sheets you mentioned.
You also need to format the results. That would be easiest when all the copying/pasting is finished.
If you need anymore help, come back here and ask.

jolivanes
03-02-2016, 01:25 PM
Re: Your post #14
If you take the apostrophe out of the Sheet Name, it'll work. That is the disadvantage of formulae.
Do you want to check all the sheet names if they have characters that are not allowed in the name, and if they do, change it?

DLStryker
03-02-2016, 01:26 PM
My workbook had a total of 30 sheets. The macro would pull the data for the first 8 sheets and then stop and give me the error code. It would not continue on through the next 22 sheets. The macro pulled the data for the first 8 sheets in half a second.

jolivanes
03-02-2016, 02:11 PM
Did you remove the apostrophe in sheet #9?
The sheet name is
Glance - Summa (092 - aloft O')
change it to
Glance - Summa (092 - aloft O)

DLStryker
03-02-2016, 03:17 PM
Did you remove the apostrophe in sheet #9?
The sheet name is
Glance - Summa (092 - aloft O')
change it to
Glance - Summa (092 - aloft O)

Yes sir. I removed the apostrophe. All is good!!! So I pulled the data for the whole company..... 175 tabs in the worksheet. Your macro pulls the data from all 175 tabs in a split second!! 6 hours of copying and pasting previously. I'm about to wet myself I am so freakin relieved!! LOL!

DLStryker
03-02-2016, 03:39 PM
Found a glitch in my methodology of pulling the data. Each and every tab is the same column wise, but not row wise. The data I am wanting to extract is in the same column on each tab, but the rows can vary. This is a system generated report I am working from and it will add additional rows, or exclude rows, depending on if data exists for that specific row. The rows that can be added or excluded is not rows that I am attempting to reference in the macro. They are detail line items and I am only interested in the sub-total lines.

So... I cannot use exact cell references in the macro. The column reference will be static, but not the row reference. I need something similar to a vlookup formula in the macro.

For example, I would be looking for "Total Operating Revenue" in the data and then go over x number of cells and retrieve that data.

Have any suggestions for that issue??

Kind regards,
Dave

jolivanes
03-02-2016, 10:23 PM
You could try this.

Sub Try_This_Way()
Dim sh1 As Worksheet, sh As Worksheet, a As String
Set sh1 = ActiveSheet
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> sh1.Name Then
a = sh1.Cells(Rows.Count, 1).End(xlUp).Address
On Error Resume Next
Range(a).Offset(1, 0).Value = Sheets(sh.Name).Cells(2, 1).Value
Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value
Range(a).Offset(1, 2).Value = Sheets(sh.Name).Columns(1).Find("Total Departmental Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 3).Value = Sheets(sh.Name).Columns(1).Find("Total Undistributed Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 4).Value = Sheets(sh.Name).Columns(1).Find("GROSS OPERATING PROFIT", , , 1).Offset(, 1).Value
On Error GoTo 0
End If
Next sh
End Sub

DLStryker
03-03-2016, 12:06 PM
You could try this.

Sub Try_This_Way()
Dim sh1 As Worksheet, sh As Worksheet, a As String
Set sh1 = ActiveSheet
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> sh1.Name Then
a = sh1.Cells(Rows.Count, 1).End(xlUp).Address
On Error Resume Next
Range(a).Offset(1, 0).Value = Sheets(sh.Name).Cells(2, 1).Value
Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value
Range(a).Offset(1, 2).Value = Sheets(sh.Name).Columns(1).Find("Total Departmental Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 3).Value = Sheets(sh.Name).Columns(1).Find("Total Undistributed Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 4).Value = Sheets(sh.Name).Columns(1).Find("GROSS OPERATING PROFIT", , , 1).Offset(, 1).Value
On Error GoTo 0
End If
Next sh
End Sub



Perfect!!! I added to the number of "find" lines of code and created a second tab in my working file to pull different data by changing the "offset". With your macro, I can pull over 5K cells of data in about a second. You have been SO helpful!!!

jolivanes
03-03-2016, 12:55 PM
Glad that it helped. Yes, it is easily adaptable.
You have to remember that there are no error traps in it, except the one.

Good luck

DLStryker
03-03-2016, 01:40 PM
Glad that it helped. Yes, it is easily adaptable.
You have to remember that there are no error traps in it, except the one.

Good luck

Thanks Again!! One quick question.... in the my data the macro is "finding" certain text, the same text exists in the same column in more than one instance. Fortunately, in this exercise, I am not looking for these instances..... , but I might be in the future.

Is there a way to (this will not be the correct verbiage) find a primary set of text and then look for a secondary set of text? An example is below.
15551

You seen that "Revenue" is listed multiple times. So if I input "Revenue" in the find line of the code, I assume it will return the first instance. Is there way to tell the macro to search for "Expenses" and then find "Revenues"?

Below is the line of code you have written that I am referring to.

Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value

Hope the above makes sense.
Dave

jolivanes
03-03-2016, 02:14 PM
The 1 in

Find("Total Operating Revenue", , , 1)
means that you want to look for an exact match.
There are other possibilities if you want. Put your cursor within the word "Find" in the code and press F1
You will see all your possibilities.

If you want to use a second same exact word, the code has to be changed to reflect that

DLStryker
03-03-2016, 02:47 PM
Put your cursor within the word "Find" in the code and press F1
You will see all your possibilities.



Sorry... when I press F1 (anywhere in the code) it opens a Explorer window with the address of https://msdn.microsoft.com/en-US/library/fp179694(v=office.15).aspx

What the heck am I doing wrong?

Regards,

jolivanes
03-03-2016, 03:39 PM
Re: What the heck am I doing wrong?
Nothing. Click on the magnifying glass at the top right and enter your question.
Did you select "Find" first before clicking on F1?

DLStryker
03-03-2016, 04:15 PM
Re: What the heck am I doing wrong?
Nothing. Click on the magnifying glass at the top right and enter your question.
Did you select "Find" first before clicking on F1?


Jeeze... I guess I'm not sure how to "select" find. I put the cursor in the "find" below and press F1. That sends me to the screen in the attachment
Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value

No matter where I put the cursor in the code, when I press F1 it takes me to the same screen in the attached. I tried highlighting all of "find" with the cursor, but still same results.

Paul_Hossler
03-03-2016, 07:16 PM
I think Excel is confused -- F1 takes me to the worksheet Find (at least with Excel 2016)


The VBA Range object Find should go here

https://msdn.microsoft.com/EN-US/library/office/ff839746.aspx

jolivanes
03-03-2016, 10:52 PM
@ Paul

I think Excel is confused
Is Excel as old as I am?

DLStryker
In addition to the site Paul gave, Ron de Bruin has some good examples on his site.
http://www.rondebruin.nl/win/s9/win006.htm

DLStryker
03-04-2016, 03:20 PM
@ Paul

Is Excel as old as I am?

DLStryker
In addition to the site Paul gave, Ron de Bruin has some good examples on his site.
http://www.rondebruin.nl/win/s9/win006.htm

I don’t know why F1 does not work in my application. The link above was helpful.

I believe I need to identify the “after” component of the find line of code.

Here is the find code I get when I use the macro record functions;
Cells.Find(What:="X", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

@jolivanes, what I copied from your code you wrote for me looks like;
Find("Total Operating Revenue", , , 1)

I’m guessing you can stream line the code by eliminating the “After:=”, “LookIn:=” from the code…. correct? jolivanes, if this is true, I don’t understand why your code would not have 7 commas.

Jolivanes, where would I enter the “after” in your code.

Am I on the right track?

Thanks!

jolivanes
03-04-2016, 04:41 PM
If I was you I would use the Range.Find method what you are comfortable with, what you understand and what is easy to change if required.
The whole proper way is

expression.Find(What:=”x”, After:=ActiveCell, LookIn:xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, MarchByte:=False, SearchFormat:=False)
Some of these can be sustituted with a 0 (zero) or 1 (one)
Which ones that are and if it is a zero, one or whatever, I don't know offhand but I am sure Google will get you there.
All that comes with learning from this site and sites like this one.
BTW, "After" is second in this whole sentence so it would go after the first comma.

jolivanes
03-04-2016, 05:16 PM
An example how you can, if you want to, use "Find" in "After"
On an empty sheet:
Cells A1:A12 all have "A" in the cells
Cell A13 has "NET INCOME" in it (without quotation marks)
Cells A14:A22 all have "B" in the cells
Cell A23 has "NET INCOME" in it (without quotation marks)
Cells A24:A34 all have "C" in the cells
Cell A35 has "NET INCOME" in it (without quotation marks)
Now run this code.

Sub Get_An_Address()
Dim a As String, b As String
a = Sheets(1).Columns(1).Find("B", , , 1).Address(0, 0)
MsgBox a
b = Sheets(1).Columns(1).Find("NET INCOME", After:=Range(a)).Address(0, 0)
MsgBox b
End Sub

DLStryker
03-09-2016, 12:22 PM
An example how you can, if you want to, use "Find" in "After"
On an empty sheet:
Cells A1:A12 all have "A" in the cells
Cell A13 has "NET INCOME" in it (without quotation marks)
Cells A14:A22 all have "B" in the cells
Cell A23 has "NET INCOME" in it (without quotation marks)
Cells A24:A34 all have "C" in the cells
Cell A35 has "NET INCOME" in it (without quotation marks)
Now run this code.

Sub Get_An_Address()
Dim a As String, b As String
a = Sheets(1).Columns(1).Find("B", , , 1).Address(0, 0)
MsgBox a
b = Sheets(1).Columns(1).Find("NET INCOME", After:=Range(a)).Address(0, 0)
MsgBox b
End Sub


I see how the above works, but, unfortunately, I was unable to adapt the above to the previous code you had helped me with.
Below is what I have as of now. I would like to change one of the existing "Find" lines to include an "After:=Range....). I see from your example, this would have to be preceded by naming a range with a "Find". Any suggestions on how I could incorporate your example above into my existing "Find"?

Sub Try_This_Way()
Dim sh1 As Worksheet, sh As Worksheet, a As String
Set sh1 = ActiveSheet
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> sh1.Name Then
a = sh1.Cells(Rows.Count, 1).End(xlUp).Address
On Error Resume Next
Range(a).Offset(1, 0).Value = Sheets(sh.Name).Cells(2, 1).Value
Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value
Range(a).Offset(1, 2).Value = Sheets(sh.Name).Columns(1).Find("Total Departmental Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 3).Value = Sheets(sh.Name).Columns(1).Find("Total Undistributed Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 4).Value = Sheets(sh.Name).Columns(1).Find("GROSS OPERATING PROFIT", , , 1).Offset(, 1).Value
Range(a).Offset(1, 5).Value = Sheets(sh.Name).Columns(1).Find(" Management Fees", , , 1).Offset(, 1).Value
Range(a).Offset(1, 6).Value = Sheets(sh.Name).Columns(1).Find("Total Non-operating Income & Expenses", , , 1).Offset(, 1).Value
Range(a).Offset(1, 7).Value = Sheets(sh.Name).Columns(1).Find(" FF&E Reserve", , , 1).Offset(, 1).Value
Range(a).Offset(1, 8).Value = Sheets(sh.Name).Columns(1).Find("EBITDA Less Replacement Reserve", , , 1).Offset(, 1).Value
Range(a).Offset(1, 9).Value = Sheets(sh.Name).Columns(1).Find(" FF&E Reserve (Contra)", , , 1).Offset(, 1).Value
Range(a).Offset(1, 10).Value = Sheets(sh.Name).Columns(1).Find("Total Interest, Depreciation & Amort", , , 1).Offset(, 1).Value
Range(a).Offset(1, 11).Value = Sheets(sh.Name).Columns(1).Find("Income Taxes", , , 1).Offset(, 1).Value
Range(a).Offset(1, 12).Value = Sheets(sh.Name).Columns(1).Find("NET INCOME", , , 1).Offset(, 1).Value
Range(a).Offset(1, 13).Value = Sheets(sh.Name).Columns(1).Find(" Total Occupancy", , , 1).Offset(, 1).Value
Range(a).Offset(1, 14).Value = Sheets(sh.Name).Columns(1).Find(" ADR", , , 1).Offset(, 1).Value
Range(a).Offset(1, 15).Value = Sheets(sh.Name).Columns(1).Find(" Total REVPAR", , , 1).Offset(, 1).Value
On Error GoTo 0
End If
Next sh
End Sub

Paul_Hossler
03-09-2016, 01:11 PM
I think you can simplify it by using some of the Excel objects and with a sub or function

No need to use Sheets(sh.Name) when you can just use the sh object directly





Option Explicit
Sub Try_This_Way_Maybe()
Dim sh1 As Worksheet, sh As Worksheet
Dim r As Range
Set sh1 = ActiveSheet

For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> sh1.Name Then
Set r = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).EntireRow
' On Error Resume Next
r.Cells(1).Value = sh.Cells(2, 1).Value

Call pvtMatchRow(sh, "Total Operating Revenue", r.Cells(2))
'Or
r.Cells(2).Value = pvtMatchRowFunc(sh, "Total Operating Revenue")

' Range(a).Offset(1, 1).Value = Sheets(sh.Name).Columns(1).Find("Total Operating Revenue", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 2).Value = Sheets(sh.Name).Columns(1).Find("Total Departmental Expenses", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 3).Value = Sheets(sh.Name).Columns(1).Find("Total Undistributed Expenses", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 4).Value = Sheets(sh.Name).Columns(1).Find("GROSS OPERATING PROFIT", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 5).Value = Sheets(sh.Name).Columns(1).Find(" Management Fees", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 6).Value = Sheets(sh.Name).Columns(1).Find("Total Non-operating Income & Expenses", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 7).Value = Sheets(sh.Name).Columns(1).Find(" FF&E Reserve", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 8).Value = Sheets(sh.Name).Columns(1).Find("EBITDA Less Replacement Reserve", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 9).Value = Sheets(sh.Name).Columns(1).Find(" FF&E Reserve (Contra)", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 10).Value = Sheets(sh.Name).Columns(1).Find("Total Interest, Depreciation & Amort", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 11).Value = Sheets(sh.Name).Columns(1).Find("Income Taxes", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 12).Value = Sheets(sh.Name).Columns(1).Find("NET INCOME", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 13).Value = Sheets(sh.Name).Columns(1).Find(" Total Occupancy", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 14).Value = Sheets(sh.Name).Columns(1).Find(" ADR", , , 1).Offset(, 1).Value
' Range(a).Offset(1, 15).Value = Sheets(sh.Name).Columns(1).Find(" Total REVPAR", , , 1).Offset(, 1).Value
' On Error GoTo 0
End If
Next sh
End Sub


Private Sub pvtMatchRow(wsLookIn As Worksheet, sFindThis As String, rPutOffsetHere As Range)
Dim i As Long
On Error GoTo NiceExit
i = Application.WorksheetFunction.Match(sFindThis, wsLookIn.Columns(1), 0)

rPutOffsetHere.Value = wsLookIn.Cells(i, 2)
Exit Sub

NiceExit:
End Sub


Private Function pvtMatchRowFunc(wsLookIn As Worksheet, sFindThis As String) As Variant
Dim i As Long
On Error GoTo NiceExit
i = Application.WorksheetFunction.Match(sFindThis, wsLookIn.Columns(1), 0)

pvtMatchRowFunc = wsLookIn.Cells(i, 2).Value
Exit Function

NiceExit:
End Function