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

[MDY]

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]

[vba]
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

[/vba]

Edit: Just read part 2!

[mdmackillop]

[vba]
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[/vba]

[MDY]

MD,
Your second formula works perfectly! Once again you amaze me! The worksheet that I need to insert this particular formula in already contains:

[VBA]Private Sub Worksheet_Change(ByVal Target As Range)[/VBA]

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]

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.
[vba]
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

[/vba]

[MDY]

Hi MD
I have noticed that because of the line:

.Columns(1).ClearContents

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

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

[mdmackillop]

Of course.
Use this bit of the code, modified as required, to set the range to be cleared.
[VBA]
For Each cel In Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp))

[/VBA]

[MDY]

Sorry MD but I don't quite understand what is required here. Should the formula look more like this?

[VBA]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[/VBA]

Thanks

[mdmackillop]

That will work. We often don't know the end of a range, so we use the Cells method to determine it dynamically
[VBA]Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).ClearContents
[/VBA]
will define the range from cell A2 to the last used cell in column A, wherever it is. A common variation of this is
[VBA]LastRow = Cells(Rows.Count, 2).End(xlUp).Row[/VBA] 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]

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:

[vba]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
[/vba]

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]

Here's a revised DoCopies. This has to be placed in a Standard Module, not the Worksheet module.
[vba]
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

[/vba]

[MDY]

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:

[vba].Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(cel) = cel.Offset(, -1)[/vba]

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...

[mdmackillop]

[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 19 Then
DoCopies
Else

[/VBA]

and
[VBA]
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

[/VBA]

[MDY]

MD,
Thanks

[MDY]

MD,
Thanks for all your replies! You've been fantastic once again! Your last post was the perfect solution!

Cheers
MDY

[MDY]

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]

You would have multiple copies of the same module, just make it variable and pass the varying bit as a parameter, like this

[vba]


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

[vba]

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
[/vba]

[MDY]

Hi XLD,
Thanks for your help mate. I ended up doing it slightly different:

[VBA]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[/VBA]

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]

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

[vba]

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
[/vba]

or even better, Select Case

[vba]

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
[/vba]

[Bob Phillips]

And it breaks the flow of code and takes far more work to add another test!