need a VB code

[Morgan]

hi, i have the code below which takes the value in cell U17 everytime it
changes, and places it in column A on a sheet called graphs thereby forming a
list down the sheet of all the values that appear in cell U17, for charting
purposes.

What i would like to do is to be able to duplicate this for different cells.
i would like to have the cell values of W25 appear in a list in column K on
the 'graphs' sheet. Could you please give me some code that will enable me to
capture the values for these two cells in sheet1 into the sheet called graphs?

any help would be greatly appreciated, thank you.

Private Sub Worksheet_Calculate()
Dim Dest As Range
With Sheets("graphs")
Set Dest = .Range("A" & Rows.Count).End(xlUp)
If Range("U17") <> Dest Then _
Dest.Offset(1) = Range("U17")
End With
End Sub

 

[Per Jessen]

Hi

This changed code should do it:

Private Sub Worksheet_Calculate()
Dim DestU As Range
Dim DestW As Range
With Sheets("graphs")
Set DestU = .Range("A" & Rows.Count).End(xlUp)
Set DestW = .Range("K" & Rows.Count).End(xlUp)
If Range("U17") <> DestU Then _
DestU.Offset(1) = Range("U17")
If Range("W25") <> DestW Then _
DestW.Offset(1) = Range("W25")
End With
End Sub

Regards,
Per

 

[Jacob Skaria]

Select the sheet tab which you want to work with. Right click the sheet tab
and click on 'View Code'. This will launch VBE. Paste the below code to the
right blank portion. Get back to to workbook and try out.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strColumn As String, lngRow As Long, ws As Worksheet

If Target.Count <> 1 Or Target.Text = "" Then Exit Sub

If Target.Address = "$U$17" Then
strColumn = "A"
ElseIf Target.Address = "$W$25" Then
strColumn = "K"
End If

If strColumn <> vbNullString Then
Set ws = Worksheets("graphs")
If WorksheetFunction.CountIf(ws.Range(strColumn & _
"1").EntireColumn, Target.Text) = 0 Then
Application.EnableEvents = False
lngRow = ws.Cells(Rows.Count, strColumn).End(xlUp).Row
ws.Range(strColumn & lngRow + 1) = Target.Text
Application.EnableEvents = True
End If
End If

End Sub

 

[Jacob Skaria]

Forgot to mention that the code posted will not track non-subsequent
duplicate entires made in those cells...If that is not your
requirment...replace the code as below

If strColumn <> vbNullString Then
Set ws = Worksheets("graphs")
Application.EnableEvents = False
lngRow = ws.Cells(Rows.Count, strColumn).End(xlUp).Row
ws.Range(strColumn & lngRow + 1) = Target.Text
Application.EnableEvents = True
End If

 

[Morgan]

thank you both very much, very helpful!

Hi

This changed code should do it:

Private Sub Worksheet_Calculate()
Dim DestU As Range
Dim DestW As Range
With Sheets("graphs")
Set DestU = .Range("A" & Rows.Count).End(xlUp)
Set DestW = .Range("K" & Rows.Count).End(xlUp)
If Range("U17") <> DestU Then _
DestU.Offset(1) = Range("U17")
If Range("W25") <> DestW Then _
DestW.Offset(1) = Range("W25")
End With
End Sub

Regards,
Per



.