Macro copying cells between sheets

C

cbrd

I have the following macro assigned to a button ("New Grass Week") in
the "Grass Cutting" sheet. It is suppose to, upon clicking, take data
from the "Customers" sheet and paste it into the proper columns in the
"Grass Cutting" sheet. It doesnt do anything when clicked and I get no
errors. I just think there something missing.

Any ideas?


URL of the .xls sheet
http://www.ashleylandscaping.com/excel-example.xls


Code:
--------------------
Sub NewGrassWeek()


Dim FilterRange As Range, CopyRange As Range
Dim c As Range, r As Range, x As Range


Set wsHistory = Sheets("Grass Cutting")
Set wsDaily = Sheets("Customers")
Set r = wsDaily.Range("I3:I6666")
Set c = wsHistory.Range("A3:A6666")
Set x = wsDaily.Range("A3:A6666")

For Each r In x

If r.Value = "y" Then

Range("A" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!A:A)"
Range("B" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!B:B)"
Range("C" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!C:C)"
Range("D" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!D:D)"
Range("E" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!E:E)"
Range("F" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!F:F)"
Range("G" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!G:G)"
Range("H" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!H:H)"
Range("L" & c.Row).Formula = "=LOOKUP(A" & c.Row & ",Customers!A:A,Customers!J:J)"

Application.ScreenUpdating = True

End If

Next r

End Sub
 
J

Jim Rech

This code is so bad it gives me a headache. But the first reason it fails
is because:

If r.Value = "y" Then

checks down column A while the "y"'s are in column I.


--
Jim
|
| I have the following macro assigned to a button ("New Grass Week") in
| the "Grass Cutting" sheet. It is suppose to, upon clicking, take data
| from the "Customers" sheet and paste it into the proper columns in the
| "Grass Cutting" sheet. It doesnt do anything when clicked and I get no
| errors. I just think there something missing.
|
| Any ideas?
|
|
| URL of the .xls sheet
| http://www.ashleylandscaping.com/excel-example.xls
|
|
| Code:
| --------------------
| Sub NewGrassWeek()
|
|
| Dim FilterRange As Range, CopyRange As Range
| Dim c As Range, r As Range, x As Range
|
|
| Set wsHistory = Sheets("Grass Cutting")
| Set wsDaily = Sheets("Customers")
| Set r = wsDaily.Range("I3:I6666")
| Set c = wsHistory.Range("A3:A6666")
| Set x = wsDaily.Range("A3:A6666")
|
| For Each r In x
|
| If r.Value = "y" Then
|
| Range("A" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!A:A)"
| Range("B" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!B:B)"
| Range("C" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!C:C)"
| Range("D" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!D:D)"
| Range("E" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!E:E)"
| Range("F" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!F:F)"
| Range("G" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!G:G)"
| Range("H" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!H:H)"
| Range("L" & c.Row).Formula = "=LOOKUP(A" & c.Row &
",Customers!A:A,Customers!J:J)"
|
| Application.ScreenUpdating = True
|
| End If
|
| Next r
|
| End Sub
| --------------------
|
|
| --
| cbrd
| ------------------------------------------------------------------------
| cbrd's Profile:
http://www.excelforum.com/member.php?action=getinfo&userid=30009
| View this thread: http://www.excelforum.com/showthread.php?threadid=498221
|
 
D

Don Guillett

you might start with

for each item in r
if item="y" then
next item

can't do each r in x
 
D

Don Guillett

I looked at your workbook. Why not just use data>filter>autofilter on "Y"
instead?
Maybe you need professional help.
 
C

cbrd

Thanks for the advice, I have almost no idea what Im doing at most
times. I have the code pasted below. It works just how I want it to.
There any 'tips' you can give me how I could clean it up?


Code:
--------------------
Sub NewGrassWeek()
Dim c As Range, r As Integer

Rows("3:250").Select
Selection.Delete Shift:=xlUp

Set wsHistory = Sheets("Grass Cutting")
Set wsDaily = Sheets("Customers")
Set c = wsHistory.Range("A3:A6666")
Set x = wsDaily.Range("A3:A6666")
r = 3
Do Until Worksheets("Customers").Cells(r, 9) = ""
If Worksheets("Customers").Cells(r, 9) = "y" Then
Worksheets("Grass Cutting").Cells(r, 1) = Worksheets("Customers").Cells(r, 1)
Worksheets("Grass Cutting").Cells(r, 2) = Worksheets("Customers").Cells(r, 2)
Worksheets("Grass Cutting").Cells(r, 3) = Worksheets("Customers").Cells(r, 3)
Worksheets("Grass Cutting").Cells(r, 4) = Worksheets("Customers").Cells(r, 4)
Worksheets("Grass Cutting").Cells(r, 5) = Worksheets("Customers").Cells(r, 5)
Worksheets("Grass Cutting").Cells(r, 6) = Worksheets("Customers").Cells(r, 6)
Worksheets("Grass Cutting").Cells(r, 7) = Worksheets("Customers").Cells(r, 7)
Worksheets("Grass Cutting").Cells(r, 8) = Worksheets("Customers").Cells(r, 8)
Worksheets("Grass Cutting").Cells(r, 12) = Worksheets("Customers").Cells(r, 10)
Application.ScreenUpdating = True
End If
r = r + 1
Loop

EndRow = Range("A1:A" & Range("A65536").End(xlUp).Row).Rows.Count
LastRow = EndRow
Range("a1").Select
For i = 1 To EndRow
Range("a" & i).Select
If ActiveCell.Row > LastRow Then
End If

If WorksheetFunction.CountIf(Range("A1:A250" & EndRow), ActiveCell.Value) > 1 Then
Selection.EntireRow.Delete
i = i - 1
EndRow = EndRow - 1
LastRow = EndRow
End If
Next i

Dim lrow As Long
For lrow = 250 To 3 Step -1
If IsEmpty(Range("A" & lrow)) Then Range("A" & lrow).EntireRow.Delete
Next lrow


End Sub
 
D

Don Guillett

Yes, my original suggestion. Autofilter the customers sheet after you have
added the additional columns desired. NO need for another sheet especially
when you have all those unnecessary cells formatted which makes the workbook
huge. Hide columns if desired.

This will do your initial filter if on the customer sheet
Sub filterdata()
Range("A2:U2").AutoFilter Field:=9, Criteria1:="y"
End Sub

Refined from recording this
Sub Macro3()
'
' Macro3 Macro
' Macro recorded 1/5/2006 by Don Guillett
'

'
Range("A2:U2").Select
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=3
Selection.AutoFilter Field:=9, Criteria1:="y"
End Sub
 

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

Top