VBA code to copy a single cell value to first unused cell in another column

[artz]

Hi,

I would appreciate some VBA help with code to copy a single cell (Q7) value to the first unused Row in column T when formulas on the worksheet recalculate.

The following code works fine for copying the cell value to the first unused Row in column T:

Sub PasteToNextEmptyRow()
Range("Q7").Copy
Sheets("Sheet1").Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub

However, there must be another macro ahead of the

PasteToNextEmptyRow

to detect the worksheet change.

Am using two methods which cause the cell formulas to update: manually editing a cell value or using the F9 key to force the entire worksheet to realculate.

So far I've tried at least a dozen VBA code formulas to trigger the macro shown above. Some only triggered (called PasteToNextEmptyRow) when I manually entered a new cell value, others went into endless loops. Still others did nothing, period. Using F9 to recalulate worksheet formulas probably produced the most instances of not calling the macro.

I am putting the code in the Sheet1 (Sheet1) code space. Is there someone in the Forum who could help with VBA could that would call the above macro whether cell values are manually edited or using the F9 key to force the entire worksheet to realculate? The range triggering the change is on Sheet1 over the range Q2:Q12.

Any suggestions or help on the VBA code would be greatly appreciated.

Thanks,

Art

 

[bebo021999]

Try with change event:
Note that it only trigger manual change in range Q2:Q12

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q2:Q12")) Is Nothing Then Exit Sub
Range("Q7").Copy
Sheets("Sheet1").Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Not sure if you want to copy only specific cell Q7 or not, but if you want to copy cell that change:
Instead of

Range("Q7").Copy

use this:

Target.Copy

 

[artz]

Try with change event:
Note that it only trigger manual change in range Q2:Q12

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q2:Q12")) Is Nothing Then Exit Sub
Range("Q7").Copy
Sheets("Sheet1").Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Not sure if you want to copy only specific cell Q7 or not, but if you want to copy cell that change:
Instead of

Range("Q7").Copy

use this:

Target.Copy

Hi bebo021999,

Thanks for your prompt reply. I see your comment that "it only trigger manual change in range Q2:Q12" This range has all cell formulas which change when some of the input cells change or the F9 key is used to recalculate all worksheet formulas. In this application, your posted code doesn't quite work.

Do you have a code suggestion to do this?

Thanks,

Art

 

[artz]

Hi bebo021999,

Thanks for your prompt reply. I see your comment that "it only trigger manual change in range Q2:Q12" This range has all cell formulas which change when some of the input cells change or the F9 key is used to recalculate all worksheet formulas. In this application, your posted code doesn't quite work.

Do you have a code suggestion to do this?

Thanks,

Art

Hi bebo021999,

I tried a couple ideas as to why the code that you posted does not seem to detect the cell formula recalculation in Q7. First I thought that maybe the code isn't finding the worksheet so I made the changes below:

     Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Sheets("Sheet1").Range("Q2:Q12")) Is Nothing Then Exit Sub
    Sheets("Sheet1").Range("Q7").Copy
    Sheets("Sheet1").Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    End Sub

This did not work. Next, I tried placing the code in a different place. Originally, I placed your code in Sheet1 (Sheet1) since that seemed logical. I then tried it in ThisWorkbook and later in Module1. These changes made no difference. What to try next?

Any suggestions?

Thanks,

Art

 

[bebo021999]

With this:
If Intersect(Target, Sheets("Sheet1").Range("Q2:Q12")) Is Nothing Then Exit Sub
seems you tried to fire change in other sheet "Sheet1"

should be:
If Intersect(Target, Range("Q2:Q12")) Is Nothing Then Exit Sub

to trigger change in Q2:Q12 at same sheet

Anyway, to fire change in range (with formula), I believe that calculate event work for whole sheet's cells, not for specific range (Q2:Q12) only.

 

[artz]

Hi bebo021999,

I tried a couple ideas as to why the code that you posted does not seem to detect the cell formula recalculation in Q7. First I thought that maybe the code isn't finding the worksheet so I made the changes below:

     Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Sheets("Sheet1").Range("Q2:Q12")) Is Nothing Then Exit Sub
    Sheets("Sheet1").Range("Q7").Copy
    Sheets("Sheet1").Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    End Sub

This did not work. Next, I tried placing the code in a different place. Originally, I placed your code in Sheet1 (Sheet1) since that seemed logical. I then tried it in ThisWorkbook and later in Module1. These changes made no difference. What to try next?

Any suggestions?

Thanks,

Art

Hi bebo021999,

In searching online, I find that the problem with the posted code is more basic. Using:

Worksheet_Change(ByVal Target As Range)

WILL NOT detect cell value changes that are calculated by formulas. Except for one cell on my woksheet that is an input, all other cells contain formulas. The worksheet is updated using the F9 function key. This reseeds the Random Number Generator which in turn causes the worksheet to recalculate the cell formulas.

There is a built-in function in the code below which detects a formula calculation in any cell on the worksheet. It does work somewhat; it does copy a value to column T, but it's not the value that I observe in Q7. I don't know where this value comes from. The code I tried is shown below:

Private Sub Worksheet_Calculate()

Application.EnableEvents = False

Range("Q7").Copy
Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

Application.EnableEvents = True

End Sub

Any thoughts?

Thanks,

Art