| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copying cells between sheets
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...o&userid=30009 View this thread: http://www.excelforum.com/showthread...hreadid=498221 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro copying cells between sheets
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 "cbrd" wrote in message ... | | 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...o&userid=30009 | View this thread: http://www.excelforum.com/showthread...hreadid=498221 | |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro copying cells between sheets
I looked at your workbook. Why not just use datafilterautofilter on "Y"
instead? Maybe you need professional help. -- Don Guillett SalesAid Software "Don Guillett" wrote in message ... you might start with for each item in r if item="y" then next item can't do each r in x -- Don Guillett SalesAid Software "cbrd" wrote in message ... 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...o&userid=30009 View this thread: http://www.excelforum.com/showthread...hreadid=498221 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro copying cells between sheets
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 -------------------- -- cbrd ------------------------------------------------------------------------ cbrd's Profile: http://www.excelforum.com/member.php...o&userid=30009 View this thread: http://www.excelforum.com/showthread...hreadid=498221 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro copying cells between sheets
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 -- Don Guillett SalesAid Software "cbrd" wrote in message ... 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 -------------------- -- cbrd ------------------------------------------------------------------------ cbrd's Profile: http://www.excelforum.com/member.php...o&userid=30009 View this thread: http://www.excelforum.com/showthread...hreadid=498221 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro copying cells between sheets
Thanks for the help Don -- cbrd ------------------------------------------------------------------------ cbrd's Profile: http://www.excelforum.com/member.php...o&userid=30009 View this thread: http://www.excelforum.com/showthread...hreadid=498221 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Copying cells between sheets in a workbook | Excel Discussion (Misc queries) | |||
| NEED a MAJOR help with SHEETS copying MACRO | Excel Discussion (Misc queries) | |||
| Copying sheets in a macro | Excel Discussion (Misc queries) | |||
| Copying Macro w/ different sheets | Excel Worksheet Functions | |||
| copying the same cells from many sheets | Excel Worksheet Functions | |||
![cbrd[_14_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
