macro looping error

P

pm

I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
 
D

Dave Peterson

So you only want to check D2 of each sheet and add that value to the new Echo
sheet?


Sub RoundToZero()
dim ws as worksheet
dim dlr as long

with worksheets("Echo")
dlr = .cells(.rows.count,1).end(xlup).row + 1

For Each ws In Worksheets
If ws.Name <> .name Then
if ws.range("D2").value = "" then
'skip it
else
.cells(dlr,"D").value = ws.range("D2").value
dlr = dlr + 1 'get ready for the next one
end if
end if
Next ws
End with
End Sub

(Untested, uncompiled. Watch for typos.)

I don't understand why the name of this procedure is named RoundToZero, though.

And I don't understand what that last portion does.
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
 
J

JLatham

Here's what I come up with. I was a bit confused as your sample code had a
title of RoundToZero and yet it does no such thing. But no matter...

Sub WorkThroughData()
Dim echoSheet As Worksheet
Dim ws As Worksheet
Dim colDRange As Range
Dim anyColDCell As Range
Dim newFormula As String

'get your Echo sheet into the
'workbook and then pick up
'here to work through the
'other sheets/data
Set echoSheet = Worksheets("Echo")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> echoSheet.Name Then
Set colDRange = ws.Range("D1:" & _
ws.Range("D" & Rows.Count).End(xlUp).Address)
For Each anyColDCell In colDRange
If Not IsEmpty(anyColDCell) Then
'you're going to want to tweak
'this formula, probably using
'the row number of anyColDCell
'as anyColDCell.Row
newFormula = "=MID('" & ws.Name & _
"'!R[3]C[3],1,5)"
'put formula into next available
'cell in column A of Echo sheet
echoSheet.Range("A" & Rows.Count). _
End(xlUp).Offset(1, 0).FormulaR1C1 _
= newFormula
End If
Next ' individual cell loop
End If
Next ' worksheet loop end
'all done, do housekeeping
Set colDRange = Nothing
Set echoSheet = Nothing
End Sub

Hope this gets things moving for you.
 
J

JLatham

I had the same question about title - and kind of same one about D2, but I
went by his description rather than the sample code. Hopefully one of us
guess close to right.

I'm thinking that what he wants is to put a variation of that =MID() formula
onto the Echo sheet to pick up the value found on the other sheets - but as I
commented in the code, that's going to take some tweaking to get it correct.

Dave Peterson said:
So you only want to check D2 of each sheet and add that value to the new Echo
sheet?


Sub RoundToZero()
dim ws as worksheet
dim dlr as long

with worksheets("Echo")
dlr = .cells(.rows.count,1).end(xlup).row + 1

For Each ws In Worksheets
If ws.Name <> .name Then
if ws.range("D2").value = "" then
'skip it
else
.cells(dlr,"D").value = ws.range("D2").value
dlr = dlr + 1 'get ready for the next one
end if
end if
Next ws
End with
End Sub

(Untested, uncompiled. Watch for typos.)

I don't understand why the name of this procedure is named RoundToZero, though.

And I don't understand what that last portion does.
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
Click to expand...
 
P

pm

Hi Dave,

No, I want to check column D in each sheet....but don't know the exact
range. As you can tell I've pieced this together....and changed it at least
12 times...lol. The last piece takes a portion of the cell content -
ex.(11002-00709 total) and copies it to the new Echo sheet....in this example
i only want 11002. Thanks.

Dave Peterson said:
So you only want to check D2 of each sheet and add that value to the new Echo
sheet?


Sub RoundToZero()
dim ws as worksheet
dim dlr as long

with worksheets("Echo")
dlr = .cells(.rows.count,1).end(xlup).row + 1

For Each ws In Worksheets
If ws.Name <> .name Then
if ws.range("D2").value = "" then
'skip it
else
.cells(dlr,"D").value = ws.range("D2").value
dlr = dlr + 1 'get ready for the next one
end if
end if
Next ws
End with
End Sub

(Untested, uncompiled. Watch for typos.)

I don't understand why the name of this procedure is named RoundToZero, though.

And I don't understand what that last portion does.
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
Click to expand...
 
D

Dave Peterson

Maybe...

Option Explicit
Sub CopyDIfNonBlank()

Dim EchoWS As Worksheet
Dim ws As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim NextRow As Long

'delete existing worksheet named Echo
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("echo").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set EchoWS = Worksheets.Add
EchoWS.Name = "Echo"

NextRow = 0
For Each ws In Worksheets
With ws
Set myRng = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
End With

For Each myCell In myRng.Cells
If myCell.Value = "" Then
'skip it
Else
NextRow = NextRow + 1
EchoWS.Cells(NextRow, "D").Value _
= Left(myCell.Value, 5)
'or ???
'= right(mycell.value,5)
'= mid(mycell.value, 3, 12)
End If
Next myCell
Next ws

End Sub

It looks in column D (D1 through the last used cell in column D). Then it loops
through those cells to determine which cell should be (partially) copied to the
Echo sheet in column D.

Echo is always created new, so there's no data in it to start. So NextRow
starts with 0 (and I add one to it before I plop the value in).

If you want to keep previous versions of the Echo worksheet, you can change
this:

NextRow = 0
to
with EchoWS
NextRow = .cells(.rows.count,"D").end(xlup).row
End with


Hi Dave,

No, I want to check column D in each sheet....but don't know the exact
range. As you can tell I've pieced this together....and changed it at least
12 times...lol. The last piece takes a portion of the cell content -
ex.(11002-00709 total) and copies it to the new Echo sheet....in this example
i only want 11002. Thanks.

Dave Peterson said:
So you only want to check D2 of each sheet and add that value to the new Echo
sheet?


Sub RoundToZero()
dim ws as worksheet
dim dlr as long

with worksheets("Echo")
dlr = .cells(.rows.count,1).end(xlup).row + 1

For Each ws In Worksheets
If ws.Name <> .name Then
if ws.range("D2").value = "" then
'skip it
else
.cells(dlr,"D").value = ws.range("D2").value
dlr = dlr + 1 'get ready for the next one
end if
end if
Next ws
End with
End Sub

(Untested, uncompiled. Watch for typos.)

I don't understand why the name of this procedure is named RoundToZero, though.

And I don't understand what that last portion does.
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
Click to expand...
Click to expand...
 
P

pm

Thanks so much for your help. I want to add to code below but not sure of
the syntax:
If Not IsEmpty(anyColDCell) And cell includes word 'Total' THEN

newFormula = "=MID('" & ws.Name & _
"'!R[3]C[3],1,5)" AND PICK UP ROW L IN EXTENDED AMT COLUMN

EXAMPLE OF WORKSHEET
Date Num PO# Item
AMT EXAMT
04/09/2009 74962 18502-05037 SHA 22111 -3.89 -4.21
04/09/2009 74962 18502-05037 SHA 22112 -3.89 -4.21
04/09/2009 74962 18502-05037 SHA 22113 -3.89 -4.21
18502-05037 Total -12.63

So on my Echosheet i would have in column A 18502 and in column B 12.63.

JLatham said:
Here's what I come up with. I was a bit confused as your sample code had a
title of RoundToZero and yet it does no such thing. But no matter...

Sub WorkThroughData()
Dim echoSheet As Worksheet
Dim ws As Worksheet
Dim colDRange As Range
Dim anyColDCell As Range
Dim newFormula As String

'get your Echo sheet into the
'workbook and then pick up
'here to work through the
'other sheets/data
Set echoSheet = Worksheets("Echo")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> echoSheet.Name Then
Set colDRange = ws.Range("D1:" & _
ws.Range("D" & Rows.Count).End(xlUp).Address)
For Each anyColDCell In colDRange
If Not IsEmpty(anyColDCell) Then
'you're going to want to tweak
'this formula, probably using
'the row number of anyColDCell
'as anyColDCell.Row
newFormula = "=MID('" & ws.Name & _
"'!R[3]C[3],1,5)"
'put formula into next available
'cell in column A of Echo sheet
echoSheet.Range("A" & Rows.Count). _
End(xlUp).Offset(1, 0).FormulaR1C1 _
= newFormula
End If
Next ' individual cell loop
End If
Next ' worksheet loop end
'all done, do housekeeping
Set colDRange = Nothing
Set echoSheet = Nothing
End Sub

Hope this gets things moving for you.

pm said:
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
Click to expand...
 
P

pm

Sorry my last message was probably very confusing. I've worked on this all
afternoon trying to get the correct syntax.....This script works great...i
just need to tweak it a bit.....In each sheet for column D if the row/cell
includes the word TOTAL ..ex (18051-0707 Total) I want to select 18051, and
if it is the total row then extact the extended cost in column L of each
sheet....and put in Echosheet. Can you please help?

JLatham said:
Here's what I come up with. I was a bit confused as your sample code had a
title of RoundToZero and yet it does no such thing. But no matter...

Sub WorkThroughData()
Dim echoSheet As Worksheet
Dim ws As Worksheet
Dim colDRange As Range
Dim anyColDCell As Range
Dim newFormula As String

'get your Echo sheet into the
'workbook and then pick up
'here to work through the
'other sheets/data
Set echoSheet = Worksheets("Echo")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> echoSheet.Name Then
Set colDRange = ws.Range("D1:" & _
ws.Range("D" & Rows.Count).End(xlUp).Address)
For Each anyColDCell In colDRange
If Not IsEmpty(anyColDCell) Then
'you're going to want to tweak
'this formula, probably using
'the row number of anyColDCell
'as anyColDCell.Row
newFormula = "=MID('" & ws.Name & _
"'!R[3]C[3],1,5)"
'put formula into next available
'cell in column A of Echo sheet
echoSheet.Range("A" & Rows.Count). _
End(xlUp).Offset(1, 0).FormulaR1C1 _
= newFormula
End If
Next ' individual cell loop
End If
Next ' worksheet loop end
'all done, do housekeeping
Set colDRange = Nothing
Set echoSheet = Nothing
End Sub

Hope this gets things moving for you.

pm said:
I have a spreadsheet that has 6 tabs and need to read the data in a specific
column (D) in each sheet...if the cell is not blank then store the data in a
new sheet....then go to next sheet and so on...i can't get my loop to
work....any suggestions?

This creates the new sheet:

Set NewSheet = Worksheets.Add
NewSheet.Name = "Echo"
Sheets("Echo").Select
Sheets("Echo").Move After:=Sheets("Store Ops")
Sheets("Apparel").Select

I want this to read data in each cell in column D for each sheet and if it's
not blank then write record to Echo sheet:

Sub RoundToZero()
For Each ws In Worksheets
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> ActiveSheet.Name Then
With ws
Cells(dlr, "d") = .Range("d2").Value
Next ws
End If
End Sub

This is the data i want to write to Echo sheet:

Sheets("Echo").Select
ActiveCell.FormulaR1C1 = "=MID(Janitorial!R[3]C[3],1,5)"
Sheets("Echo").Select
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
Placing the MsgBox "No ID found" statement in my code?? 12
Select Case Code does not run... 10
End(xlDown) Issue 1
Code copies twice...? 13
Dealing with the error: unable to filter on excel hc home school 0
Search other sheets for numbers & color them 10
Macro 3

Top