PDA

View Full Version : Please help - Procedure too long in VBA



maorlov
12-20-2015, 11:25 AM
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
12-20-2015, 11:36 AM
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
12-20-2015, 11:50 AM
Thank yo very much for your help! Works perfectly!!!

p45cal
12-20-2015, 12:00 PM
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
12-20-2015, 12:15 PM
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
12-20-2015, 12:37 PM
I don't understand, what do you want to do?

maorlov
12-20-2015, 12:42 PM
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
12-20-2015, 12:54 PM
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
12-20-2015, 12:58 PM
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
12-20-2015, 01:20 PM
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
12-20-2015, 01:27 PM
yes, that is what I wanted! Thank you!

SamT
12-20-2015, 04:10 PM
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
12-20-2015, 04:27 PM
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
12-20-2015, 04:39 PM
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