PDA

View Full Version : Problem Looping thru Worksheets



zest1
10-21-2006, 09:07 AM
I have a few different subs that I incorprated into one and need to have it loop thru all the worksheets, but the code just repeats or attempts to run again on the first sheet until it errors out, never shifting to the next sheet.

I'm sure the problem is obvious, esp. to a more experienced eye. Can someone kindly take a look and see what the problem is. See attachment if needed...

Thanks a lot!

Sub ProjectFormatter()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'concatenate "Project" & "Cost" cells
Dim cell As Range
Dim sStart As String
Dim rng As Range

With Columns(1)
Set cell = .Find("Project")
If Not cell Is Nothing Then
If cell.Row > 2 Then
sStart = cell.Address
Do
cell.Offset(0, 0).Value = cell.Offset(0, 0).Value & " - " & _
cell.Offset(1, 0).Value
If rng Is Nothing Then
Set rng = cell.Offset(1, 0)
Else
Set rng = Union(rng, cell.Offset(1, 0))
End If
Set cell = .FindNext(cell)
Loop Until cell Is Nothing Or cell.Address = sStart
End If
End If
End With

If Not rng Is Nothing Then rng.EntireRow.Delete
'move "Project" cells up to same row as Phase (in col. D)
For Each c In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c

'------------------------------------------------------------

Dim LastRow As Long
Dim aCount As Long
Dim iCount As Long
Dim I As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

Range("A3").Select
Do While ActiveCell.Row < LastRow
'//Must be a value in col A
If InStr(1, ActiveCell.Offset(0, 2), "Project") Then
'//When project line move down to first task
ActiveCell.Offset(1, 0).Select
Do While InStr(1, ActiveCell.Offset(0, 2), "Project") = 0
'//move down task rows until next project found
If ActiveCell.Row > LastRow Then
'//trap for when at end of dataset
Exit Do
Else
'//actually move down and count rows moved
ActiveCell.Offset(1, 0).Select
aCount = aCount + 1
End If
Loop
'//determine if any rows need inserting
iCount = (10 - aCount)
If iCount > 0 Then
'//don't insert when <= 0
For I = 1 To iCount
ActiveCell.EntireRow.Insert
ActiveCell.Offset(1, 0).Select
Next I
'//shift last row count by inserted rows amount
LastRow = LastRow + iCount
End If
'//reset count
aCount = 0
End If
Loop
Application.ScreenUpdating = True
Next ws
End Sub

Norie
10-21-2006, 09:30 AM
You aren't actually referencing the worksheets you are looping through, so whenever you have something like this:

Columns(1) It will refer to the currently active sheet.

What you need is something like this.

With ws.Columns(1)

Also you don't need to select.

Simon Lloyd
10-21-2006, 09:37 AM
Hi im by far an expert and i didnt test this until the code finished but it now moves on a sheet to perform the code again!


Sub ProjectFormatter()
Application.ScreenUpdating = False
Dim ws As Worksheet
For ic = 1 To Sheets.Count ''''''''''Added This!
'For Each ws In Sheets
'concatenate "Project" & "Cost" cells
Dim cell As Range
Dim sStart As String
Dim rng As Range
Sheets(ic).Select ''''''Added This!
With Columns(1)
Set cell = .Find("Project")
If Not cell Is Nothing Then
If cell.Row > 2 Then
sStart = cell.Address
Do
cell.Offset(0, 0).Value = cell.Offset(0, 0).Value & " - " & _
cell.Offset(1, 0).Value
If rng Is Nothing Then
Set rng = cell.Offset(1, 0)
Else
Set rng = Union(rng, cell.Offset(1, 0))
End If
Set cell = .FindNext(cell)
Loop Until cell Is Nothing Or cell.Address = sStart
End If
End If
End With

If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
'move "Project" cells up to same row as Phase (in col. D)
For Each c In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c

'------------------------------------------------------------

Dim LastRow As Long
Dim aCount As Long
Dim iCount As Long
Dim I As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

Range("A3").Select
Do While ActiveCell.Row < LastRow
'//Must be a value in col A
If InStr(1, ActiveCell.Offset(0, 2), "Project") Then
'//When project line move down to first task
ActiveCell.Offset(1, 0).Select
Do While InStr(1, ActiveCell.Offset(0, 2), "Project") = 0
'//move down task rows until next project found
If ActiveCell.Row > LastRow Then
'//trap for when at end of dataset
Exit Do
Else
'//actually move down and count rows moved
ActiveCell.Offset(1, 0).Select
aCount = aCount + 1
End If
Loop
'//determine if any rows need inserting
iCount = (10 - aCount)
If iCount > 0 Then
'//don't insert when <= 0
For I = 1 To iCount
ActiveCell.EntireRow.Insert
ActiveCell.Offset(1, 0).Select
Next I
'//shift last row count by inserted rows amount
LastRow = LastRow + iCount
End If
'//reset count
aCount = 0
End If
Loop
Application.ScreenUpdating = True
'Next ws
Next ic '''''Added this!
End Sub
Regards,
Simon

Simon Lloyd
10-21-2006, 09:57 AM
Add this line after Next ic if you wish just to prove to yourself that it actually has completed all sheets MsgBox "finished at sheet " & ic - 1Regards,
Simon

Norie
10-21-2006, 10:06 AM
Simon

That might work but there really is no need to select anything.

In fact because of the use of ActiveCell later in the code it could actually cause problems.

I don't have the time right now but I'll download the OP's attachment and post back later with what I think the code should be.:)

Simon Lloyd
10-21-2006, 10:27 AM
Norie, i'm ever happy to learn.....i just saw that his code wasnt actually being asked to move on a sheet so i thoufht it need to count sheets to move on, i do understand what you were saying about the With statement, its just because im still quite a novice compared to most of you i "couldn't see the woods for the trees!", i did think that in a with statement you can reference an object without slecting or activating it.

look forward to your post!

Regards,
Simon

Norie
10-21-2006, 10:46 AM
Here's what I came up with.

The code runs and it definitely does something, but I don't know if it does what it's intended to do.

Sub ProjectFormatter()
Dim ws As Worksheet
Dim c As Range
Dim sStart As String
Dim rng As Range
Dim LastRow As Long
Dim aCount As Long
Dim iCount As Long
Dim I As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
Set rng = Nothing
With ws.Columns(1)
Set c = .Find("Project")
If Not c Is Nothing Then
If c.Row > 2 Then
sStart = c.Address
Do
c.Offset(0, 0).Value = c.Offset(0, 0).Value & " - " & c.Offset(1, 0).Value
If rng Is Nothing Then
Set rng = c.Offset(1, 0)
Else
Set rng = Union(rng, c.Offset(1, 0))
End If
Set c = .FindNext(c)
Loop Until c Is Nothing Or c.Address = sStart
End If
End If
End With

If Not rng Is Nothing Then rng.EntireRow.Delete

'move "Project" cells up to same row as Phase (in col. D)
For Each c In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

Set rng = ws.Range("A3")
Do While rng.Row < LastRow
'//Must be a value in col A
If InStr(rng.Offset(0, 2), "Project") Then
'//When project line move down to first task
Set rng = rng.Offset(1, 0)
Do While InStr(rng.Offset(0, 2), "Project") = 0
'//move down task rows until next project found
If rng.Row > LastRow Then
'//trap for when at end of dataset
Exit Do
Else
'//actually move down and count rows moved
Set rng = rng.Offset(1, 0)
aCount = aCount + 1
End If
Loop
'//determine if any rows need inserting
iCount = (10 - aCount)
If iCount > 0 Then
'//don't insert when <= 0
For I = 1 To iCount
rng.EntireRow.Insert
Set rng = rng.Offset(1, 0)
Next I
'//shift last row count by inserted rows amount
LastRow = LastRow + iCount
End If
'//reset count
aCount = 0
End If
Set rng = rng.Offset(1)
Loop

Next ws
Application.ScreenUpdating = True
End Sub

zest1
10-21-2006, 11:27 AM
Norie,
thanks for your help.

I ran the code, but it still does not progress to the subsequent sheets.

Also, the last section of the code now no longer works. It's supposed to add rows btwn the "Phases" entries on the sheet so that each Phase group has 10 rows.

Norie
10-21-2006, 11:48 AM
The code I posted will loop through the sheets.

Like I said I don't know if the code does what it's intended to, because well I don't know what that is.

Perhaps if you explained that I could check it further.

Norie
10-21-2006, 11:54 AM
Actually I think I found the problem.

'move "Project" cells up to same row as Phase (in col. D)
For Each c In ws.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c
The problem, again, was the missing reference to the worksheet.

I thought I'd spotted all of them but I missed that one.:omg2:

But I'm still not 100% sure if the code will do what it's meant to.

zest1
10-21-2006, 12:34 PM
Ok Norie.

I left the code in sections to make each section more evident in what it does, and to make it easier to troubleshoot in anticipation that any changes would affect the function of certain parts of it.

The worksheet has groups of entries, labeled "Phases" plus various data below. Each section of the code simply reformats the data in the following way:

The first section of the code concatenates all the "Cost" cells at the end of the "Project" cells (and adds " - " in between), and deletes those now empty rows where the "Cost" cells used to be.

The second section of the code then cuts the new (concatenated) "Project & Cost" cells and shifts them up 1 row and 2 columns over.

The third (last) section of the code checks to make sure that each "Phase" group contains 10 rows, and will add rows at the end of the "numbered" (ie. 1, 2, 3...) rows so that each group has 10 rows.

The entire code used to work fine before - and all I wanted was to have it move onto and run on the other sheets. But now there's a problem with the last section - it no longer add rows, but strangely adds a row in the wrong place - below "Phase 4" and below the "1" in that group.

Anyway, I tried running the code a few more times, but once again, it only runs on Sheet1, with no change to the other sheets (2 & 3). Btw, I have xl2k.

Hope this helps.
Thanks :)

Norie
10-21-2006, 12:47 PM
Did you try the last piece of code I posted?

zest1
10-21-2006, 01:01 PM
Norie,
I posted before I saw your last post.

Ok, made the correction you posted and the code now seems to run like it did before - it generates a "Runtime error 424 Object required" error on sheet1, and still does not transitioning to the other sheets.

edit - the macro errors here:
If Not rng Is Nothing Then rng.EntireRow.Delete

Thanks

Simon Lloyd
10-21-2006, 01:28 PM
Zest you need to put an end if after that staement i saw that in your code and added one!

If Not rng Is Nothing Then
rng.EntireRow.Delete
End If


regards,
Simon

zest1
10-21-2006, 01:42 PM
thanks Simon,

I had a suspicion about that. I made the change and the code now generates a "Runtime error 1004" here:


Set rng = Union(rng, cell.Offset(1, 0))

???

Simon Lloyd
10-21-2006, 01:45 PM
yep i got that but in the code i posted when i saved the workbook opened it and ran it again it went through no problem.

Regards,
Simon

P.S just for tryings sake try the code i posted, its not as pretty as norie's but then im a novice - but it worked for me

Simon Lloyd
10-21-2006, 01:49 PM
The problem is caused on sheets2 & 3 in the first cell where you have Company: ABC it has too many spaces if you take one space out on both sheets it works fine!
regards,
Simon

zest1
10-21-2006, 02:11 PM
Ok Simon,

I inserted your code, and although the it now transitions to sheet2, it generates the same "Runtome error 1004" here:


Set rng = Union(rng, cell.Offset(1, 0))

Not sure what you're referring to about the spaces on sheets 2 & 3 - I searched those sheets for extra (double) spaces and found none.

Anyway, I think we're getting closer, thanks to both yours and Norie's help.

Simon Lloyd
10-21-2006, 05:05 PM
At the top of each sheet you have Cell A1 which contains Company: ABC, there are 2 spaces here it needs to be one or if there is one space it needs to be one these only occur at the top of sheets 2 & 3 remove the spaces your code runs fine!

Regards,
Simon

zest1
10-21-2006, 05:18 PM
Simon,
there are no extra spaces in A1 of sheets 2 & 3. Those pages are exact replicas (copy & paste) of sheet1. Besides I don't see why that would be an issue - nothing in the code checks for that.

I've tried repeatedly to get the code to run, but it just stops at that one point. It's got to be something really simple that we're overlooking.

Perhaps you could just attach the file, since you've got it working.

Thanks for your continued help on this.

Norie
10-21-2006, 07:26 PM
So nobody tried the code I posted?

zest1
10-21-2006, 08:11 PM
Norie,
I just pasted your code into my module again, and lo-and-behold - the strangest thing - it finally worked this time! Well, sort of.

I didn't do anything different than the other times when I copied & pasted it, and it wouldn't work. Very strrrrrrrraaaaaange!

Anyway, the code in fact does run through the other worksheets, but the problem with the last section of code still exists. As I said before, it's supposed to add rows at the end of each group of entries so that each group has 10 rows. The code currently does not do that - but instead it adds rows where it shouldn't (between the numbered rows).

It would be great if you could fix that.
Thanks again for your help! :)

Simon Lloyd
10-22-2006, 01:17 AM
Well on the workbook you posted thats where the problem lies, if its a copy of the worksheet were you copying the whole sheet or did you do it by cell manipulating the cell as you go? this is where your problem could be, but trust me to get the code to run i removed those spaces i mentioned.

Regards,
Simon

Norie
10-22-2006, 01:30 AM
zest1

I don't actually recall you saying what the code was meant to do, but I might have missed that.

What would really help would be if you attached a before and after workbook.

zest1
10-22-2006, 06:37 AM
Simon,
the sheets are totally IDENTICAL - I did a CTRL+A on sheet1 and then pasted that sheet's contents to sheets 2 & 3. There's no way they could be different. I just checked the workbook I posted yet once more, and there are no extra spaces. But again, even if there were extra spaces, how would that be the problem? The code does NOT check for such spaces.

Norie,
I outlined several posts back what the code does - it simply formats data and rearranges it on the sheet according to how I described in that post - The workbook contains various company "projects phases" summaries which need to be rearranged on the sheet. The code concatenates & shift cells around and adds rows (so that each "Phase" entry group has 10 rows.

The code is in 3 sections:
1. concatenating cells
2. shifting of cells
3. counting & adding (for a total of 10) rows.

Your code does stream through all the sheets, but it malfunctions at the last (adding of rows) section. Whatever you changed in the code has altered its function - it no longer adds the counts & adds rows to each group, but inserts a row in the wrong places in the "Phase 4" group.

If you want a before & after look, all you have to do is run the code in the original workbook that I posted (without "Next ws") - it runs perfectly on sheet1. Then just compare sheet1 to sheet2 and you will see the difference. If you count the number of rows in each group, each sould now have 10 rows - this is to space each of the groups consistently down the sheet. it's pretty clear after running the code.

And Simon, your code generates the same error at this line "Set rng = Union(rng, cell.Offset(1, 0))", but on sheet2 (at least it's now attempting to move though the sheets).

We're ever so close...
Thanks again to you both for your patience :)

Simon Lloyd
10-22-2006, 07:22 AM
Zest i found the problem! where you have your Union(rng...etc rng is nothing i dont know how to fix it prettily but this worked
Else
Set rng = cell.Offset(1, 0)
Set rng = Union(rng, cell.Offset(1, 0))
End Ifit finished the sheets doing what you wished without errors!

Regards,
Simon

zest1
10-22-2006, 07:43 AM
Simon,
ok, the code now successfully streams through all the sheets. :)

BUT, the ROWs from which the concatenated cells used to reside are no longer being deleted (except in the last ("Phase 4") group :(

BTW, I'm still wondering where those spaces you mentioned came from, haha!!!

Norie
10-22-2006, 07:43 AM
This appears to work on the sample workbook.

Sub ProjectFormatter()
Dim ws As Worksheet
Dim c As Range
Dim sStart As String
Dim rng As Range
Dim LastRow As Long
Dim aCount As Long
Dim iCount As Long
Dim I As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
Set rng = Nothing
With ws.Columns(1)
Set c = .Find("Project")
If Not c Is Nothing Then
If c.Row > 2 Then
sStart = c.Address
Do
c.Offset(0, 0).Value = c.Offset(0, 0).Value & " - " & c.Offset(1, 0).Value
If rng Is Nothing Then
Set rng = c.Offset(1, 0)
Else
Set rng = Union(rng, c.Offset(1, 0))
End If
Set c = .FindNext(c)
Loop Until c Is Nothing Or c.Address = sStart
End If
End If
End With

If Not rng Is Nothing Then rng.EntireRow.Delete

'move "Project" cells up to same row as Phase (in col. D)
For Each c In ws.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

Set rng = ws.Range("A3")

Do
Set rng = rng.End(xlDown)

If rng.Row = Rows.Count Then Exit Do
If rng.Value < 7 Then
rng.Offset(1).Resize(7 - rng.Value).EntireRow.Insert
Set rng = rng.End(xlDown)
End If
Loop Until rng.Row = Rows.Count

Next ws

Application.ScreenUpdating = True

End Sub

Simon Lloyd
10-22-2006, 07:52 AM
If i was a bit more experienced and as clever as Norie i would have spotted this

Else
Set rng = Union(rng, c.Offset(1, 0))
End If

but i wasn't :(

regards,
Simon

zest1
10-22-2006, 08:01 AM
NORIE,
THANK YOU - THAT WORKED!!!

I couldn't see exactly what you changed in the code, but I'll have to go over and study it.

Simon, don't be too hard on yourself - you are to be commended for your attempts to help out. We're all eternally learning. :)

Anyway, I really appreciate both of your help on this, truly!
Thanks again!
:beerchug:

Norie
10-22-2006, 08:12 AM
zest

I just totally redid the part for inserting rows, I was having trouble following the logic of the original code, though it did seem to work.

By the way note I said it worked on your sample workbook, so it might not even work or could need changes for the 'real' data.

Anyways, give it a try and post back if you need further help.:)

zest1
10-22-2006, 08:39 AM
Norie,
how does one change the "number of added rows" setting? I may want to increase it to say 15. How do I do that?

Norie
10-22-2006, 09:40 AM
I think, but I'm not sure, you could change the 7 to 12 here.

rng.Offset(1).Resize(7 - rng.Value).EntireRow.Insert

zest1
10-22-2006, 10:50 AM
you're right Norie,
doesn't work on the real data :(

This has me extremely perplexed - I mean, even going back to the original code, it works perfectly on the first sheet, yet I just can't understand why it won't continue to run on the other sheets :banghead:

Anyway, don't sweat it, it's not worth the time. I can just run the code on each sheet manually, no problem. Besides, I'm sure there'll be other more important issues later I could use your help with later.

Again, thanks a lot for trying. I really appreciate it! :friends:

Norie
10-22-2006, 12:11 PM
zest

How does it not work on the 'real' data?

Any chance of posting some more representative data?

Zack Barresse
10-24-2006, 04:11 PM
I think you all are missing the entire point of referencing the worksheet (as you have with variables), unless the assumed references are on purpose. Like this code ..

For Each c In ws.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(WorksheetFunction.Substitute(c, "Project", "")) <> Len(c) Then
c.Cut c.Offset(-1, 2)
c.Offset(1, 0).EntireRow.Delete
End If
Next c

In particular, look at the first line...

For Each c In ws.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

Notice anything wrong yet?

Now let's look at the range being declared...

ws.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

Now, look closer at the row portion of that range...

Cells(Rows.Count, 1).End(xlUp).Row)

Notice anything wrong about this? It's missing six characters ("ws." repeated twice). Both the Cells argument and the Rows.Count argument are going to be looking at the activesheet and will not be looping.

There are also references in the code such as...

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

Whereas this is not real detrimental to what sheet you are on, just that you have a sheet active. If you are using this code in an addin, you will have a much greater chance of something like this failing. In this particular example, the first range portion is declared, yet the row part is not, it's assumed.


I doubt any of this really affected much, although I have not tested whatsoever, it is just items you may look for in the future for explicitly referencing your objects.

HTH