Solved: Edit this loop to loop through all Sheets

[YellowLabPro]

I have read a few examples on how to loop through each sheet in an activeworkbook, but to now avail have I been able to solve.
http://www.mrexcel.com/archive2/55800/64786.htm

I have added a counter, but not sure where this should go in the loop, source: http://support.microsoft.com/kb/213621

One thought is that if there is no "x" on a sheet then the loop may stop.
I did add the line On Error Resume, but again, not sure where to place may be the hold-up. It has been commented to avoid any other complications.

'On Error Resume Next



For n = 1 To Wss_Count
For Each Ash In ActiveWorkbook.Worksheets
For i = 12 To LRow
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1
If Wss.Cells(i, 7) = "x" Then
Wst.Cells(LRowt, 2).Value = Wss.Cells(i, 4).Value 'Item#
Wst.Cells(LRowt, 3).Value = Wss.Cells(i, 1).Value 'Item
Wst.Cells(LRowt, 4).Value = Wss.Cells(i, 2).Value 'Color
Wst.Cells(LRowt, 7).Value = Wss.Cells(i, 26).Value 'Cost
Wst.Cells(LRowt, 9).Value = Wss.Cells(i, 6).Value 'Delivery
End If
Next i
Next Ash
MsgBox ActiveWorkbook.Worksheets(n).Name
Next n

[malik641]

YLP,

I'm not sure what you're doing...what's LRowt for? When do you get LRow? Could you provide a workbook?

[Aussiebear]

Google search picked up this one Doug.

www.vba (http://www.%3Cb%3Evba%3C/b%3E)express.com/kb/getarticle.php?kb_id=390


Edit: Didn't come out right but you'll get the drfit

[YellowLabPro]

Thanks Ted,
I will start on it...

Joseph-

I'm not sure what you're doing...what's LRowt for? When do you get LRow? Could you provide a workbook?

If you are not sure, then you can rest assured I sure as H.... don't know what I am doing...:rotlaugh:

LRowt is finding the Last Row on my target sheet.

LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1

Is this what you are questioning?

What I am doing is, or want to do is loop through every sheet in a workbook and find any item marked w/ an "x" and copy this item back to my master workbook sheet.

Do you still want to see a copy of the workbook? It is just a Purchase Order worksheet I designed.... and this procedure then copies the items I want to order from the companies order form to mine...

Does this help?

[YellowLabPro]

Ted,
Is this the article you were referring to?
http://vbaexpress.com/forum/showthread.php?t=9882&garpg=6

[malik641]

If you are not sure, then you can rest assured I sure as H.... don't know what I am doing...:rotlaugh::rotlaugh:that's funny



LRowt is finding the Last Row on my target sheet.

LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1

Is this what you are questioning?This is my mistake. I should have seen that part, but I overlooked it. Sorry. I was more curious about LRow rather than LRowt. And I was kind of hoping to see the entire procedure...but I think I'm starting to see what's going on.



What I am doing is, or want to do is loop through every sheet in a workbook and find any item marked w/ an "x" and copy this item back to my master workbook sheet.
Ok. But I don't know what you're doing with that one For Loop (For i = 12 To LRow). It's like you're just repeating the same code (12 - LRow) times for no reason.

So Here's what I'm assuming you need:
Public Sub CopyToMaster()
Dim lLastRow As Long, lMSdataRow As Long
Dim ws As Excel.Worksheet
Dim wsMaster As Excel.Worksheet

Set wsMaster = ThisWorkbook.Worksheets("Master")
' Last row in Master Sheet
lMSdataRow = wsMaster.Cells(Rows.Count, "A").End(xlUp).Row

For Each ws In ActiveWorkbook.Worksheets
' Verify that ws is not the Master Sheet
If ws.Name <> wsMaster.Name Then
' Get lLastRow of ws
lLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' Store values into Master sheet
For i = 12 To lLastRow
wsMaster.Cells(lMSdataRow, 2).Value = ws.Cells(i, 4).Value 'Item#
wsMaster.Cells(lMSdataRow, 3).Value = ws.Cells(i, 1).Value 'Item
wsMaster.Cells(lMSdataRow, 4).Value = ws.Cells(i, 2).Value 'Color
wsMaster.Cells(lMSdataRow, 7).Value = ws.Cells(i, 26).Value 'Cost
wsMaster.Cells(lMSdataRow, 9).Value = ws.Cells(i, 6).Value 'Delivery

' Increment lMSdataRow for new row in Master Sheet
lMSdataRow = lMSdataRow + 1
Next i
MsgBox ws.Name
End If
Next ws
End Sub

If this doesn't suit your needs, then yes, I would like to see the workbook :)

Good luck Yelp

[YellowLabPro]

I will read your code, here is mine



Sub Copy_Data_Master_PO()
Dim Wbs As Workbook
Dim Wss As Worksheet, Wst As Worksheet, Ash As Worksheet
Dim LRow As Long, LRowt As Long
Dim i As Integer, t As Integer, n As Integer, Wss_Count As Integer
Set Wbs = ActiveWorkbook
Set Wss = ActiveWorkbook.ActiveSheet
Set Wst = Workbooks("Master PO.xls").Worksheets("FF")
LRow = Wss.Cells(Rows.Count, 1).End(xlUp).Row
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1
Wss_Count = ActiveWorkbook.Worksheets.Count
Application.EnableEvents = False

'On Error Resume Next
'For n = 1 To Wss_Count
For Each Wss In ActiveWorkbook.Worksheets
For i = 12 To LRow
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1
If Wss.Cells(i, 7) = "x" Then
Wst.Cells(LRowt, 2).Value = Wss.Cells(i, 4).Value 'Item#
Wst.Cells(LRowt, 3).Value = Wss.Cells(i, 1).Value 'Item
Wst.Cells(LRowt, 4).Value = Wss.Cells(i, 2).Value 'Color
Wst.Cells(LRowt, 7).Value = Wss.Cells(i, 26).Value 'Cost
Wst.Cells(LRowt, 9).Value = Wss.Cells(i, 6).Value 'Delivery
End If
Next i
Next Wss
'MsgBox ActiveWorkbook.Worksheets(n).Name
'Next n
Wst.Calculate
Application.EnableEvents = True
End Sub

[YellowLabPro]

For i =12 to LRow
goes through the source sheet beginning at row 12 to the last row looking for "x"
LRowT is looping through target sheet placing the values in correct row from the source sheet. By doing it this way this finds the last row in the target sheet + 1 and places the next "x" in there.
This line sits inside the loop so it iterates every time too.
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1

[YellowLabPro]

Malik,
Ok, Got it to run and loop through all the sheets. But it did not find any of the "x" that were marked on the source sheets.

I am reposting my entire code for reference if any help....
The thing I watched is that the variables of LRow and LRowt never change, meaning as the code loops through each row of the sheet, the neither of these nor the integer, (i) ever change in value. So it appears to not to include this in the loop, but rather the names are not matching up.



Option Explicit
Sub Copy_Data_Master_PO()
Dim Wbs As Workbook
Dim Wss As Worksheet, Wst As Worksheet, Wsl As Worksheet
Dim LRow As Long, LRowt As Long, lLRow As Long
Dim i As Integer, t As Integer, n As Integer, Wss_Count As Integer
Set Wbs = ActiveWorkbook
Set Wss = ActiveWorkbook.ActiveSheet
Set Wst = Workbooks("Master PO.xls").Worksheets("FF")
LRow = Wss.Cells(Rows.Count, 1).End(xlUp).Row
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1
Wss_Count = ActiveWorkbook.Worksheets.Count
Application.EnableEvents = False

For Each Wsl In ActiveWorkbook.Worksheets
If Wsl.Name <> Wss.Name Then
lLRow = Wsl.Cells(Rows.Count, 1).End(xlUp).Row
For i = 12 To LRow
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row + 1
If Wss.Cells(i, 7) = "x" Then
Wst.Cells(LRowt, 2).Value = Wss.Cells(i, 4).Value 'Item#
Wst.Cells(LRowt, 3).Value = Wss.Cells(i, 1).Value 'Item
Wst.Cells(LRowt, 4).Value = Wss.Cells(i, 2).Value 'Color
Wst.Cells(LRowt, 7).Value = Wss.Cells(i, 26).Value 'Cost
Wst.Cells(LRowt, 9).Value = Wss.Cells(i, 6).Value 'Delivery
End If
Next i
MsgBox Wsl.Name
End If
Next Wsl
Wst.Calculate
Application.EnableEvents = True
End Sub

[Bob Phillips]

Be very carefule with Resume Next, you will likely obscure real errors using that technique.

[YellowLabPro]

Yes, I think that is good sound advice. I was only trying to see if that were the problem of why the loop was not running past the first sheet. It did not work anyway so I pulled it out.

[YellowLabPro]

Malik,
I just found a big problem. The code issue still exists, but the data on the worksheet got corrupted. It was the strangest thing- Wss (The source worksheet), col. C had data in it down to row 31, so when the code ran and I checked the status of the LRow it kept showing LRow was equal to 16.
I went back to the worksheet and did an Ctl Down beginning in row 16 and it jumped down to row 133 and then Ctl UP went back to row 16. It did not think it had any data in those rows, so this was throwing another item into the mix. Once I deleted the data, it then behaved just the opposite, it jumped from 16 to 31 and from 31 to 133, back from 133 to 31 to 16 when there was no data in there at all.
I saved the workbook for you to have a look at it. I want to send it to Xld and MDmackillop to see what they think. It is the weirdest thing.

But I did also discover that while looping through the sheets works w/ my current code, it does not like the naming convention and I don't see the problem.

Crossposted here: I started there on a different topic: how to find LRow and did not want to leave the posters there un-notified since this has some inter-relationship.
http://www.ozgrid.com/forum/showthread.php?p=361493&posted=1#post361493

[Bob Phillips]

posting cancelled

[mdmackillop]

Hi Doug,
I posted about a similar problem here (http://www.vbaexpress.com/forum/showthread.php?t=10322&highlight=EMPTY). I never did find the reason.

[YellowLabPro]

Yes I see the similarity when looking for blank rows and it jumps past. In my sheet I sent you, But if you delete the data in C16:C31 and then do a Ctl Down it stops where there was data. It is like some Excel control is seeing it backwards. Can you try this and post back?

[YellowLabPro]

So where I am is that it loops through all the sheets in the workbook, it just does not loop through the cells of the sheets of the workbook....

Any ideas here?

[YellowLabPro]

Solved:
Thanks Malik- your example helped me to see the proper order, I kept fiddling w/ it until I got it to work.
Here is the final version, just in case anyone else comes along and needs some help on a similar project...


Sub Copy_Data_Master_PO()
Dim Wbs As Workbook, Wbt As Workbook
Dim Wss As Worksheet, Wst As Worksheet, Wsl As Worksheet
Dim LRow As Long, LRowt As Long, lLRow As Long
Dim i As Integer, t As Integer, n As Integer, PCol As Integer, Wss_Count As Integer
Set Wbs = ActiveWorkbook
Set Wbt = Workbooks("Master PO.xls")
Set Wss = Wbs.ActiveSheet
Set Wst = Wbt.Worksheets("FF")
Wss_Count = Wbs.Worksheets.Count
Application.EnableEvents = False
LRow = Wss.Cells(Rows.Count, 2).End(xlUp).Row
LRowt = Wst.Cells(Rows.Count, 1).End(xlUp).Offset(0, 2).End(xlUp).Row
For Each Wss In Wbs.Worksheets
If Wss.Name <> Wst.Name Then 'Test w/out .Name
For i = 12 To LRow
If Wss.Cells(i, 7) = "x" Then
With Wst
.Cells(LRowt, "B").Value = Wss.Cells(i, "D").Value 'Item#
.Cells(LRowt, "C").Value = Wss.Cells(i, "A").Value 'Item Name
.Cells(LRowt, "D").Value = Wss.Cells(i, "B").Value 'Color
.Cells(LRowt, "G").Value = Wss.Cells(i, "Z").Value 'Cost
.Cells(LRowt, "I").Value = Wss.Cells(i, "F").Value 'Delivery Date
End With
LRowt = LRowt + 1
End If
Next i
'MsgBox Wss.Name
End If
Next Wss
Wst.Calculate
Application.EnableEvents = True
End Sub

[malik641]

Wow...too much happened in one day that I missed!! I'll be back tomorrow to catch up.