PDA

View Full Version : Solved: Copy & paste a cell and row times defined number



MDY
02-21-2007, 04:10 PM
Hi,
Just wondering if anyone has worked out how to copy and paste a cell and insert the appropriate text and rows in a new sheet by another dependent number entered. For example if: A2="A2" and A3="7" copy the contents of A2 for 7 rows into anther sheet. This should continue for the range A1:A1000 and the new rows are to continue underneath those already inserted. If the number 7 is changed then the 7 rows which were previously inserted into the other sheet should be modified to match the new number entered. Please see attached file:

mdmackillop
02-21-2007, 04:20 PM
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Sheets("Sheet to Copy to").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Target) = Target.Offset(, -1)
End If
End Sub



Edit: Just read part 2!

mdmackillop
02-21-2007, 04:29 PM
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel as Range
If Target.Column = 2 Then
With Sheets("Sheet to Copy to")
.Columns(1).ClearContents
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)
Next
End With
End If
End Sub

MDY
02-21-2007, 04:39 PM
MD,
Your second formula works perfectly! Once again you amaze me! The worksheet that I need to insert this particular formula in already contains:

Private Sub Worksheet_Change(ByVal Target As Range)

and hence I am recieving the error "Ambigious Name Detected: Worksheet Change" How am i able to get around this? Your help is much appreciated, i'm still pretty new to this but learning fast thanks to yours and others help.

Thanks so much!

mdmackillop
02-21-2007, 04:49 PM
You can only have one Worksheet_Change event per sheet. What you need to is test the address of the target which triggers the change and call a sub (or run code) based on this result.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then DoCopies
If Not Intersect(Target, Range("C1:C10")) Is Nothing Then MsgBox "Test"
End Sub
Sub DoCopies()
Dim cel as Range
With Sheets("Sheet to Copy to")
.Columns(1).ClearContents
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)
Next
End With
End Sub

MDY
02-21-2007, 05:20 PM
Hi MD
I have noticed that because of the line:


.Columns(1).ClearContents

my headers are being deleted. Is there any way to start .ClearContents of at row 2?

I'm almost there with this one. Thanks again.

mdmackillop
02-21-2007, 05:27 PM
Of course.
Use this bit of the code, modified as required, to set the range to be cleared.

For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))

MDY
02-21-2007, 05:51 PM
Sorry MD but I don't quite understand what is required here. Should the formula look more like this?

Sub DoCopies()
With Sheets("Sheet to Copy to")
Range(A2, A1000).ClearContents
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)
Next
End With
End Sub

Thanks

mdmackillop
02-21-2007, 05:59 PM
That will work. We often don't know the end of a range, so we use the Cells method to determine it dynamically
Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).ClearContents

will define the range from cell A2 to the last used cell in column A, wherever it is. A common variation of this is
LastRow = Cells(Rows.Count, 2).End(xlUp).Row which gives the row number.
Rows.Count is used instead of 65536 to protect against spreadsheet size changes, as is happening with Excel 2007.

MDY
02-21-2007, 07:44 PM
Sorry MD but the formula is now clearing the wrong sheet. It is now clearing the first sheet that it is ment to be copying from. The formula I am now using is as follows:

Sub DoCopies()
With Sheets("Sheet to Copy to")
Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).ClearContents
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)
Next
End With
End Sub


Sorry but once again i have made this all to confusing. The sheet that the formula should clear is "Sheet to Copy to" and the range in that sheet that the formula should clear from is A2. Do you hgave any solutions? I have attached the sheet, Hope this helps!

Thanks so much!

mdmackillop
02-22-2007, 06:55 AM
Here's a revised DoCopies. This has to be placed in a Standard Module, not the Worksheet module.

Sub DoCopies()
With Sheets("Sheet to Copy to")
.Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).ClearContents
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)
Next
End With
End Sub

MDY
02-22-2007, 10:52 PM
MD,
I think were almost there with this one but i get an error when I put the VBA formula into my actual spreadsheet. I have attached the spreadsheet for you to have a look at hopefully this will make it easier. The line where the error is appearing is:

.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)

I'm sorry but I can't quite understand what is meant to happen here. I know that it is trying to insert the contents though. The cell contents is clearing correctly but I get a runtime error on this line.

In this spreadsheet I have highlighted the headers in RED where VBA should be working.

Essentially:
1. Clear contents "Sewer Junction" Range B4 on Change in S4 "Sewer"
2. Count S4 "Sewer" and copy the text from G4 "Sewer" .
3. Insert those number of lines from S4 "Sewer" with the Text from G4 "Sewer" into the sheet "Sewer Junction" Range B4

If you want another challenge along with this formula is it possible to also number each line that is inserted 1,2,3 etc. from S4 "Sewer" up until that number and insert it into C4 "Sewer Junction". Then start again 1,2,3 etc. for the number of lines that are inserted for S5 "Sewer"?

Thanks for All of your help MD, I owe U...:beerchug:

mdmackillop
02-23-2007, 08:31 AM
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 19 Then
DoCopies
Else



and

Sub DoCopies()
With Sheets("Sewer Junctions")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Sewer").Range(Cells(4, 7), Cells(Rows.Count, 7).End(xlUp))
If cel.Offset(, 12) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 12)) = cel
End If
Next
End With
End Sub

MDY
02-25-2007, 03:23 PM
MD,
Thanks

MDY
02-25-2007, 03:25 PM
MD,
Thanks for all your replies! You've been fantastic once again! Your last post was the perfect solution!

Cheers
MDY

MDY
09-20-2007, 02:57 PM
Hi MD/Anyone who possibly knows?,
As this spread sheet has progressed I was wondering if it is possible to name the module DoCopies? The problem is that I now need to do a number of references on different sheets that use the DoCopies function and need to refer to a number of different modules. Is there any way of naming the DoCopies in the module so that I can use the same function on a number of different sheets for the same purpose? Your help here would be much appreciated!!!

Bob Phillips
09-20-2007, 03:07 PM
You would have multiple copies of the same module, just make it variable and pass the varying bit as a parameter, like this




Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 19 Then
DoCopies Me.Name
Else




Sub DoCopies(ByVal shName As String)
With Sheets("Sewer Junctions")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets(shName).Range(Cells(4, 7), Cells(Rows.Count, 7).End(xlUp))
If cel.Offset(, 12) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 12)) = cel
End If
Next
End With
End Sub

MDY
09-20-2007, 09:47 PM
Hi XLD,
Thanks for your help mate. I ended up doing it slightly different:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 9 Then
With Sheets("Valves")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 5) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 5)) = cel
End If
Next
End With
Else

If Target.Column = 10 Then
With Sheets("Hydrants")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 6) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 6)) = cel
End If
Next
End With
Else


If Target.Column = 11 Then
With Sheets("Bends")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 7) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 7)) = cel
End If
Next
End With
Else

If Target.Column = 12 Then
With Sheets("End Caps")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 8) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 8)) = cel
End If
Next
End With
Else

I found that buy doing it this way, although messy, it works exactly as I would like. Hopefully I will get a bit of a chance to tiddy up the code later. This code was embedded directly into the sheet rather than using modules.

Thanks for all your help and theres no doubt I will find the need for your code later.

Cheers
MDY

Bob Phillips
09-21-2007, 01:17 AM
I have to say, taht is the worst way to do it (well not the worst, wrong would be worst).

If you logic changes, you have to change 4 slabs of code in exactly the same way! And it would be so easy to create a called procedure.

And finally, even with this style, you can stop it indenting so much by using EldeIf, like so



Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 9 Then
With Sheets("Valves")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 5) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 5)) = cel
End If
Next
End With
ElseIf Target.Column = 10 Then
With Sheets("Hydrants")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 6) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 6)) = cel
End If
Next
End With
ElseIf Target.Column = 11 Then
With Sheets("Bends")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 7) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 7)) = cel
End If
Next
End With
ElseIf Target.Column = 12 Then
With Sheets("End Caps")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 8) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 8)) = cel
End If
Next
End With
Else


or even better, Select Case



Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target.Column
Case 9
With Sheets("Valves")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 5) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 5)) = cel
End If
Next
End With
Case 10
With Sheets("Hydrants")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 6) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 6)) = cel
End If
Next
End With
Case Is = 11
With Sheets("Bends")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 7) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 7)) = cel
End If
Next
End With
Case Is = 12
With Sheets("End Caps")
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, 8) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 8)) = cel
End If
Next
End With

Bob Phillips
09-21-2007, 01:18 AM
And it breaks the flow of code and takes far more work to add another test!

MDY
09-21-2007, 07:14 PM
Thats really clever, slowly (very slowly) i'm learning more about Vba code.
There is still on little problem though. If cell 4,2 is empty on any of the sheets then it deletes the the sub heading contained in 3,2. after that it then pastes the data as required in cell 2,2 under the main header. Its not something i'm overly phased about but it is pretty anoying. OIf you have any suggestions on how to fix this then that would be excellent!

Thanks for all your help thus far.

Mdy

Thanks for all your help

mdmackillop
09-22-2007, 01:37 AM
I agree with XLD regarding your repeated code. To make any change as suggested above meand 4 changes to the module. Call a common procedure as below. There is an error when I run this, inherited from your code and I don't know what you really intend. Once this is resolved, I'll have a look at post #21
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 9
Call MakeChanges("Valves", 5)
Case 10
Call MakeChanges("Hydrants", 6)
Case Is = 11
Call MakeChanges("Bends", 7)
Case Is = 12
Call MakeChanges("End Caps", 8)
End Select
End Sub

Sub MakeChanges(shName As String, col As Long)
Dim cel As Range
With Sheets(shName)
.Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents
For Each cel In Sheets("Water").Range(Cells(4, 4), Cells(Rows.Count, 4).End(xlUp))
If cel.Offset(, col) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 5)) = cel '<+++Error
End If
Next
End With
End Sub

MDY
10-14-2007, 09:10 PM
Hi All,
Thanks for helping me out with this spread sheet. It is much appreciated. I thought that I should include a copy of it for you to have a look at. I have deleted some of the sheets that are used and just included example ones.

How the Water Sheet Works:
When we enter the certain number into the field "Water J4" the text from the corresponding cell "E4" will be repeated to the same values in the sheet "Water Stop Valves". There are a number of other sheets this occurs for (K4:S4) but they have been removed for this demonstration. Each of the sheets has the same template for the first 6 columns.

Current Errors and Problems.
As has been stated some of the VBA code is repeated heavily in the "Water" sheet. The code almost works perfectly only when refreshing, the code will delete the headers of the sheet "Water Stop Valves" unless there is already text in the first row of the sheet. To see the error occur first delete all text from "Water Stop Valves B4" then enter a number into
the field J4.

My apologies if this is confusing but I?m not sure how else to explain it. All your help is much appreciated. None of the information contained in the sheet is private or confidential. Feel free to as for any other information.

Thanks so much!

MDY