Please help - Procedure too long in VBA

[maorlov]

Dear all,

I need a help with putting my code into loop because my procedure is too long and I don't know how to do that :/. I have many cells that can be user modifiable and 5 different options (countries). Aim is that when user changes value of one cell (e.g. C14) for particular option in one sheet, that this value 'goes' into the 'Data sheet'.

Sample of my code is below. I have many more lines like this. Thank you very much for your help!!!

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$14" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C53").Value = Target.Value
End If
End If
If Target.Address = "$C$15" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C54").Value = Target.Value
End If
End If
If Target.Address = "$C$16" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C55").Value = Target.Value
End If
End If
If Target.Address = "$C$17" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C56").Value = Target.Value
End If
End If

[p45cal]

this is just for the code you wrote, up to you to change it for the cells you want it to respond to:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToProcess As Range
Set RngToProcess = Intersect(Range("C14:C17"), Target)
For Each cll In RngToProcess.Cells
  If IsNumeric(cll.Value) And Range("P5") = 1 Then Worksheets("Data Sheet").Range("C" & cll.Row + 39).Value = cll.Value
Next cll
End Sub

[maorlov]

Thank yo very much for your help! Works perfectly!!!

[p45cal]

I missed something out:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToProcess As Range
Set RngToProcess = Intersect(Range("C14:C17"), Target)
If Not RngToProcess Is Nothing Then
  For Each cll In RngToProcess.Cells
    If IsNumeric(cll.Value) And Range("P5") = 1 Then Worksheets("Data Sheet").Range("C" & cll.Row + 39).Value = cll.Value
  Next cll
End If
End Sub

[maorlov]

Thank you again! Can I please ask you one more thing.

If I want that range is e.g. c14: E17 how to write that in syntax for range ' Range("C" & cll.Row + 39) '? I am trying few things but I have an error.

[p45cal]

I don't understand, what do you want to do?

[maorlov]

Now the range was c14:c17, but in the real file the range expands form c14:g17 and I don't know how to adjust above code in the part underlined below. Can you please help me?

If IsNumeric(cll.Value) And Range("P5") = 1 Then Worksheets("Data Sheet").Range("C" & cll.Row + 39).Value = cll.Value

[p45cal]

So where do you want to put values from:
D14
E15
F16
G17

Answer those and I should be able to discern the pattern.

[maorlov]

Not really, the desired range is every cell from c14:G17 so I want that each of these cells is modifiable. I will include bit more sample code (from c to D) so maybe it will be clearer. Sorry for not explain it better.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$14" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C53").Value = Target.Value
End If
End If
If Target.Address = "$C$15" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C54").Value = Target.Value
End If
End If
If Target.Address = "$C$16" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C55").Value = Target.Value
End If
End If
If Target.Address = "$C$17" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("C56").Value = Target.Value
End If
End If
'D'
If Target.Address = "$D$14" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("D53").Value = Target.Value
End If
End If
If Target.Address = "$D$15" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("D54").Value = Target.Value
End If
End If
If Target.Address = "$D$16" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("D55").Value = Target.Value
End If
End If
If Target.Address = "$D$17" Then
If IsNumeric(Target.Value) And Range("P5") = 1 Then
Worksheets("Data Sheet").Range("D56").Value = Target.Value
End If
End If

[p45cal]

Not really,

??!!

I'm going to assume the following:
D14 >> D53
E15 >> E54
F16 >> F55
G17 >> G56

('cos that's all I wanted to know):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToProcess As Range
Set RngToProcess = Intersect(Range("C14:G17"), Target)
If Not RngToProcess Is Nothing Then
  For Each cll In RngToProcess.Cells
    If IsNumeric(cll.Value) And Range("P5") = 1 Then Worksheets("Data Sheet").Range(cll.Offset(39).Address).Value = cll.Value
  Next cll
End If
End Sub

[maorlov]

yes, that is what I wanted! Thank you!

[SamT]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If (IsNumeric(Target) And Range("P5") = 1) And _
Not Intersect(Target, Range("C14:E17")) Is Nothing Then AdjustData Target
End Sub

Sub AdjustData(Rng As Range)
Worksheets("Data Sheet").Range(Rng.Address).Offset(, 39).Value = Rng.Value
End Sub

[snb]

Private Sub Worksheet_Change(ByVal Target As Range) 
    on error resume next
    If Target * cells(5,16) = target and Not Intersect(Target, Range("C14:E17")) Is Nothing Then target.offset(39)=Target.value
End Sub

[p45cal]

Private Sub Worksheet_Change(ByVal Target As Range) 
    on error resume next
    If Target * cells(5,16) = target and Not Intersect(Target, Range("C14:E17")) Is Nothing Then target.offset(39)=Target.value
End Sub

should be:
…Then Worksheets("Data Sheet").Range(target.offset(39).address)=Target.value