VBA: Copy Destination question and auto trigger

[musoguy]

I was wondering if there was a way to paste to multiple destinations using VBA within one copy destination argument. I should add that the cell I am using as a reference point is a variable that I created earlier in the process (with a little help from mikerickson!)

The code I currently have is:

Sub find_last_row_of_data()
Dim rFoundCell As Range

    With ActiveSheet.Cells
        Set rFoundCell = .Columns(1).Find("*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious, False, False)
    End With
    

rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 2)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 4)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 6)


End Sub

Using the "Copy Destination" the way I have does the job and works fine. However there are about thirty other cells I have to add that the cell gets pasted to. Is there a better way to do this?

Secondly, and here is where I have no clue how to proceed, I need the finished sub to run automatically in the worksheet, so that each time the user adds a value in the next empty row in Column A, it will run the code. I should also add that the user actually enters the information on a different worksheet, the cells in Column A are linked to it using a formula. So there will be no actual physical imputing of data on this page, but the cell will still go from blank (with a formula) to a text string as it's value.

Really hope someone can help, particularly with the second part of the problem, as past creating a private sub in the worksheet (by right clicking on the tab and choosing "View Code"), I have no idea where to start.

 

[Peter_SSs]

I was wondering if there was a way to paste to multiple destinations using VBA within one copy destination argument.

Using the "Copy Destination" the way I have does the job and works fine. However there are about thirty other cells I have to add that the cell gets pasted to. Is there a better way to do this?

Assuming the 30 (or whatever number) of cells are a continuation of the pattern shown (ie every second cell to the right of rFoundCell then try this type of structure.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> find_last_row_of_data()<br>    <SPAN style="color:#00007F">Dim</SPAN> rFoundCell <SPAN style="color:#00007F">As</SPAN> Range, rDest <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> CopyCols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 30<br>    <br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet.Cells<br>        <SPAN style="color:#00007F">Set</SPAN> rFoundCell = .Columns(1).Find("*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious, <SPAN style="color:#00007F">False</SPAN>, <SPAN style="color:#00007F">False</SPAN>)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rDest = rFoundCell.Offset(1)<br>    <SPAN style="color:#00007F">For</SPAN> c = 1 <SPAN style="color:#00007F">To</SPAN> CopyCols<br>        <SPAN style="color:#00007F">Set</SPAN> rDest = Union(rDest, rFoundCell.Offset(0, c * 2))<br>    <SPAN style="color:#00007F">Next</SPAN> c<br>    <SPAN style="color:#00007F">Set</SPAN> rDest = Intersect(rDest, rFoundCell.EntireRow)<br>    <br>    rFoundCell.Offset(-1, 2).Copy Destination:=rDest<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>


However, I'm wondering if we knew a bit more about what is being copied (that is, what is in rFoundCell.Offset(-1,2) ) there may possibly be other ways to skin the cat.

Secondly, and here is where I have no clue how to proceed, I need the finished sub to run automatically in the worksheet, so that each time the user adds a value in the next empty row in Column A, it will run the code. I should also add that the user actually enters the information on a different worksheet, the cells in Column A are linked to it using a formula. So there will be no actual physical imputing of data on this page, but the cell will still go from blank (with a formula) to a text string as it's value.

Really hope someone can help, particularly with the second part of the problem, as past creating a private sub in the worksheet (by right clicking on the tab and choosing "View Code"), I have no idea where to start.

That is the place to start. As we did in your other thread here the Worksheet_Change event is used for that sort of triggering. We just need to use it on the sheet where the physical data entry is made. (BTW, how did that last code go in the other thread? )

There could be some complications, like ..

- Is is possible that more than one entry could be made at a time on the physical entry sheet (eg Copy/Paste) as that may complicate the code?

- Is it possible that the user could delete an entry (or more than one at once) on the physical data entry sheet and have you considered what should happen on this sheet if that does happen?

 

[musoguy]

Hi Peter, thanks for the reply, you are quickly becoming my savior! I actually haven't had a chance to try out the other code yet, as I haven't actually created the finished worksheet yet! This post is another part of the workbook (on a different sheet), and I am trying to do it in stages so I don't completely confuse myself (and somewhat failing!) I will of course let you know when I do create the page and put the code in it.

As to this problem: I should start by saying that the whole need for this code has come about because I am using a diminishing validation list based on a dynamic named range. In itself that took forever, to figure out a workaround to make it happen. The problem is if there is a formula in say the 50 cells below the final one with a value in it, then I get 50 empty rows in the drop down list. Checking the "ignore blank" box doesn't do anything. Therefore the only way I could figure out to solve this was to have the formulas appear as they produce a result (a text string).

I've pasted a very basic dummy version below:

Excel Workbook
	A	B	C	D	E
3		PERIOD 1		PERIOD 2
4
5	Names	Row #	List	Row #	List
6	Teacher 1	6	Teacher 1	6	Teacher 1
7	Teacher 2	7	Teacher 2	7	Teacher 2
8	Teacher 3	8	Teacher 3	8	Teacher 3
9	Teacher 4	9	Teacher 4	9	Teacher 4
Acting

Excel 2010

Cell Formulas
Range	Formula
A6	=StaffNamesbyDept!A3
A7	=StaffNamesbyDept!A4
A8	=StaffNamesbyDept!A5
A9	=StaffNamesbyDept!A6
B6	=IF(COUNTIF(MonWedFri!$C$8:$AH$9,$A6)>=1,"",ROW())
B7	=IF(COUNTIF(MonWedFri!$C$8:$AH$9,$A7)>=1,"",ROW())
B8	=IF(COUNTIF(MonWedFri!$C$8:$AH$9,$A8)>=1,"",ROW())
B9	=IF(COUNTIF(MonWedFri!$C$8:$AH$9,$A9)>=1,"",ROW())
C6	=IF(ROW($A6)-ROW($A$6)+1>COUNT(B$6:B$42),"",INDEX(A:A,SMALL(B$6:B$42,1+ROW($A6)-ROW($A$6))))
C7	=IF(ROW($A7)-ROW($A$6)+1>COUNT(B$6:B$42),"",INDEX(A:A,SMALL(B$6:B$42,1+ROW($A7)-ROW($A$6))))
C8	=IF(ROW($A8)-ROW($A$6)+1>COUNT(B$6:B$42),"",INDEX(A:A,SMALL(B$6:B$42,1+ROW($A8)-ROW($A$6))))
C9	=IF(ROW($A9)-ROW($A$6)+1>COUNT(B$6:B$42),"",INDEX(A:A,SMALL(B$6:B$42,1+ROW($A9)-ROW($A$6))))
D6	=IF(COUNTIF(MonWedFri!$C$13:$AH$14,$A6)>=1,"",ROW())
D7	=IF(COUNTIF(MonWedFri!$C$13:$AH$14,$A7)>=1,"",ROW())
D8	=IF(COUNTIF(MonWedFri!$C$13:$AH$14,$A8)>=1,"",ROW())
D9	=IF(COUNTIF(MonWedFri!$C$13:$AH$14,$A9)>=1,"",ROW())
E6	=IF(ROW($A6)-ROW($A$6)+1>COUNT(D$6:D$42),"",INDEX(C:C,SMALL(D$6:D$42,1+ROW($A6)-ROW($A$6))))
E7	=IF(ROW($A7)-ROW($A$6)+1>COUNT(D$6:D$42),"",INDEX(C:C,SMALL(D$6:D$42,1+ROW($A7)-ROW($A$6))))
E8	=IF(ROW($A8)-ROW($A$6)+1>COUNT(D$6:D$42),"",INDEX(C:C,SMALL(D$6:D$42,1+ROW($A8)-ROW($A$6))))
E9	=IF(ROW($A9)-ROW($A$6)+1>COUNT(D$6:D$42),"",INDEX(C:C,SMALL(D$6:D$42,1+ROW($A9)-ROW($A$6))))

Column A is the column where new names appear, columns B & C create the diminishing validation list. Column C is the dynamic named range that the list is created from. Hope you're still with me! Column E is another validation list, and so it goes on with Columns G, I, K and M.

So when a name appears via the calculation in Column A, the code should add formulas to Columns C, E, G, I, K and M, by copying it down from the row above (or in my current code, copying it once from Column C and pasting it to all the other columns - either way works as I have been careful as to what are relative and what are absolute references in the formula.)


As to the second part of the question: only one entry should be made at a time. They may possibly copy and paste, but only one cell at a time.

Your second point is uncanny! I just was thinking the same thing before you sent a reply! And you are right, it would be a problem. If someone deletes an entry on the other sheet so it disappears from Column A, the formulas in the corresponding columns would also have to be deleted. Come to think of it, this could be the one time when multiple cells are cut and pasted by the user in the input page, to fill in the gap that has been left. This is getting more complicated by the second!

As to your comment in the other thread, I am indeed staying up ridiculously late at the moment. I think this is due to the amount of coffee I am drinking trying to create this workbook!

Again Peter, I can't thank you enough for your help thus far, and hope what I've mentioned above is possible...and makes sense

 

[musoguy]

Hi Peter,

The code you gave me above works great as a regular macro, which is what it is. I wanted it to trigger automatically, so put it is the worksheet code box as a Worksheet_Calculate event (as the changes in Column A happen via a formula.) However it didn't work, and instead all sorts of strange things started happening in the separate sheet I was inputting the data into that appears in Column A! I realize that this has to do with the fact that it uses the active sheet, but I can't work out how to make it point to the other sheet (Sheet2), and if indeed the code will work as a Worksheet_Calculate Event.

James

 

[Peter_SSs]

Well, I have given this some thought but the whole thing it a bit complex to get your head around when it is not your own workbook, it is not in front of you and there is a fair bit going on. For me this task seems to have arrived at the point where the time required to get a full understading of the whole workbook, what you are trying to achieve and develop suitable code is beyond what is reasonable for a free public forum.

If small bits of the project can be isolated and clearly stated/demonstrated here then I am sure you will still get help, including from me if I think I can help.

 

[musoguy]

Fair enough Peter, thanks for all your help.

 

[musoguy]

Hi folks. I can't believe it but I actually figured out a code that does what I needed it to do! I'm learning! It ain't pretty, but it does the job. Mostly. There are two things that it won't do. Firstly if the name added to Column A (via a formula) is not in the neighbor row to the last populated one, it doesn't work. Not too much of a problem as I can't see why the user would ever leave blank rows when filling in the data.

Secondly, and more importantly if more than one row is deleted at the same time, the code only works on one row, not all the deleted ones. Is there an easy modification to make that not so? My guess is no from what Peter said, but thought I'd ask. As it is, I am pouring myself a drink for figuring this out (however inelegant I'm sure my code is!) The code is below:

Private Sub Worksheet_Calculate()

Dim LastCellColumn As Range
Dim LastCellColumnC As Range
Dim rFoundCell As Range
Dim rFoundForm As Range

    If WorksheetFunction.CountA(Cells) > 0 Then
    
    With Sheets("Acting").Cells
        Set rFoundCell = .Columns(1).Find("*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious, False, False)
        Set rFoundForm = .Columns(3).Find("*", .Cells(1, 3), xlFormulas, xlPart, xlByRows, xlPrevious, False, False)
        End With

Set LastCellColumn = rFoundForm.Offset(0, -2)
Set LastCellColumnC = rFoundCell.Offset(0, 2)


If IsEmpty(LastCellColumnC) = True Then
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 2)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 4)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 6)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 8)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 10)
rFoundCell.Offset(-1, 2).Copy Destination:=rFoundCell.Offset(0, 12)
End If

If LastCellColumn.Value = 0 Then

rFoundForm.ClearContents
rFoundForm.Offset(0, 2).ClearContents
rFoundForm.Offset(0, 4).ClearContents
rFoundForm.Offset(0, 6).ClearContents
rFoundForm.Offset(0, 8).ClearContents
rFoundForm.Offset(0, 10).ClearContents
End If


End If

End Sub

James

 

[musoguy]

So I've found one more problem in my coding. I really need the code to only work from row 7 onwards (although the code can be copied from row 6).

I tried changing

        Set rFoundCell = .Columns(1).Find("*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious, False, False)
        Set rFoundForm = .Columns(3).Find("*", .Cells(1, 3), xlFormulas, xlPart, xlByRows, xlPrevious, False, False)

to

        Set rFoundCell = .Columns(1).Find("*", .Cells(7, 1), xlValues, xlPart, xlByRows, xlPrevious, False, False)
        Set rFoundForm = .Columns(3).Find("*", .Cells(7, 3), xlFormulas, xlPart, xlByRows, xlPrevious, False, False)

but it didn't work. Not sure why?

 

[MrWillz]

I just tried this and it worked. I assume you can substitute the range statement for your OFFSET statements.

With Range("A4:C11")
.Copy Destination:=Sheets(Mnth).Range("E4:F4")
.Copy Destination:=Sheets(Mnth).Range("I4:J4")
.Copy Destination:=Sheets(Mnth).Range("I4:J4")
.Copy Destination:=Sheets(Mnth).Range("M4:N4")
.Copy Destination:=Sheets(Mnth).Range("Q4:R4")

End With