Combine two codes in one worksheet change events

S

Schturman

Board Regular
Joined
May 28, 2022
Messages
63
Office Version
  1. 2019
Platform
  1. Windows
Hi to all
I have two almost the same codes but for different ranges. Separately they working perfect, but If I combine them, only one working, in range ("F25:F50") and NOT for range ("E12:E24").
How to combine them correctly ?
Joe4 it's your code, maybe you can help me again ? :)
Thanks

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Source: https://www.mrexcel.com/board/threads/copy-cell-value-via-vba-if-specific-cell-is-changed.1233988/post-6047652
    Dim rng As Range
    Dim cell As Range
   
'   See if any cells updated in column C
    Set rng = Intersect(Target, Range("F25:F50"))
    If rng Is Nothing Then Exit Sub

'   Loop though all updated rows in column C
    For Each cell In rng
        If IsNumeric(cell.Value) And cell.Value > 0 Then
            Application.EnableEvents = False
            If cell.Offset(0, 2) > 0 Then
              cell.Offset(0, -1) = Range("G3") * cell * (1 + Range("$I$3"))
              Else
              cell.Offset(0, -1) = Range("G3") * cell
            End If
              Range("E11") = Range("F11") * Range("G3")
              Range("G11") = Range("E11") / Range("H3")
              cell.Offset(0, 1) = Range("G3") * cell / Range("H3")
              cell.Offset(0, -2) = Range("H3")
              cell.Offset(0, -3) = Range("G3")
              cell.Offset(0, -4) = Date
        Else
            Application.EnableEvents = False
            cell.Offset(0, 0) = "0"
            cell.Offset(0, 1) = "0"
            cell.Offset(0, 2) = ""
            cell.Offset(0, -1) = "0"
            cell.Offset(0, -2) = ""
            cell.Offset(0, -3) = ""
            cell.Offset(0, -4) = ""
        End If
       
     Next cell
    
     Application.EnableEvents = True 'reenable events
End Sub

And second one:

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Source: https://www.mrexcel.com/board/threads/copy-cell-value-via-vba-if-specific-cell-is-changed.1233988/post-6047652
    Dim rng2 As Range
    Dim cell As Range

    Set rng2 = Intersect(Target, Range("E12:E24"))
    If rng2 Is Nothing Then Exit Sub
    
     For Each cell In rng2
        If IsNumeric(cell.Value) And cell.Value > 0 Then
            Application.EnableEvents = False
              cell.Offset(0, 1) = cell / Range("G3")
              cell.Offset(0, 2) = cell / Range("H3")
              Range("E11") = Range("F11") * Range("G3")
              Range("G11") = Range("E11") / Range("H3")
              cell.Offset(0, -1) = Range("H3")
              cell.Offset(0, -2) = Range("G3")
              cell.Offset(0, -3) = Date
        Else
            Application.EnableEvents = False
            cell.Offset(0, 0) = "0"
            cell.Offset(0, 1) = "0"
            cell.Offset(0, 2) = "0"
            cell.Offset(0, -1) = ""
            cell.Offset(0, -2) = ""
            cell.Offset(0, -3) = ""
        End If
     Next cell
   
    Application.EnableEvents = True 'reenable events
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
There are probably better ways of doing this but give this a try.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Source: https://www.mrexcel.com/board/threads/copy-cell-value-via-vba-if-specific-cell-is-changed.1233988/post-6047652
    Dim rng As Range, rng2 As Range
    Dim cell As Range
   
'   See if any cells updated in column F or E
    Set rng = Intersect(Target, Range("F25:F50"))
    Set rng2 = Intersect(Target, Range("E12:E24"))
    If rng Is Nothing And rng2 Is Nothing Then Exit Sub

    Application.EnableEvents = False
    If Not rng Is Nothing Then
    '   Loop though all updated rows in column C
        For Each cell In rng
            If IsNumeric(cell.Value) And cell.Value > 0 Then
                If cell.Offset(0, 2) > 0 Then
                  cell.Offset(0, -1) = Range("G3") * cell * (1 + Range("$I$3"))
                  Else
                  cell.Offset(0, -1) = Range("G3") * cell
                End If
                  Range("E11") = Range("F11") * Range("G3")
                  Range("G11") = Range("E11") / Range("H3")
                  cell.Offset(0, 1) = Range("G3") * cell / Range("H3")
                  cell.Offset(0, -2) = Range("H3")
                  cell.Offset(0, -3) = Range("G3")
                  cell.Offset(0, -4) = Date
            Else
                cell.Offset(0, 0) = "0"
                cell.Offset(0, 1) = "0"
                cell.Offset(0, 2) = ""
                cell.Offset(0, -1) = "0"
                cell.Offset(0, -2) = ""
                cell.Offset(0, -3) = ""
                cell.Offset(0, -4) = ""
            End If
           
         Next cell
    End If
    
    If Not rng2 Is Nothing Then
        For Each cell In rng2
           If IsNumeric(cell.Value) And cell.Value > 0 Then
                 cell.Offset(0, 1) = cell / Range("G3")
                 cell.Offset(0, 2) = cell / Range("H3")
                 Range("E11") = Range("F11") * Range("G3")
                 Range("G11") = Range("E11") / Range("H3")
                 cell.Offset(0, -1) = Range("H3")
                 cell.Offset(0, -2) = Range("G3")
                 cell.Offset(0, -3) = Date
           Else
               cell.Offset(0, 0) = "0"
               cell.Offset(0, 1) = "0"
               cell.Offset(0, 2) = "0"
               cell.Offset(0, -1) = ""
               cell.Offset(0, -2) = ""
               cell.Offset(0, -3) = ""
           End If
        Next cell
    
    End If
    Application.EnableEvents = True 'reenable events
End Sub
 
Upvote 1
Solution
Alex Blakenburg said:
There are probably better ways of doing this but give this a try.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'Source: https://www.mrexcel.com/board/threads/copy-cell-value-via-vba-if-specific-cell-is-changed.1233988/post-6047652
    Dim rng As Range, rng2 As Range
    Dim cell As Range
  
'   See if any cells updated in column F or E
    Set rng = Intersect(Target, Range("F25:F50"))
    Set rng2 = Intersect(Target, Range("E12:E24"))
    If rng Is Nothing And rng2 Is Nothing Then Exit Sub

    Application.EnableEvents = False
    If Not rng Is Nothing Then
    '   Loop though all updated rows in column C
        For Each cell In rng
            If IsNumeric(cell.Value) And cell.Value > 0 Then
                If cell.Offset(0, 2) > 0 Then
                  cell.Offset(0, -1) = Range("G3") * cell * (1 + Range("$I$3"))
                  Else
                  cell.Offset(0, -1) = Range("G3") * cell
                End If
                  Range("E11") = Range("F11") * Range("G3")
                  Range("G11") = Range("E11") / Range("H3")
                  cell.Offset(0, 1) = Range("G3") * cell / Range("H3")
                  cell.Offset(0, -2) = Range("H3")
                  cell.Offset(0, -3) = Range("G3")
                  cell.Offset(0, -4) = Date
            Else
                cell.Offset(0, 0) = "0"
                cell.Offset(0, 1) = "0"
                cell.Offset(0, 2) = ""
                cell.Offset(0, -1) = "0"
                cell.Offset(0, -2) = ""
                cell.Offset(0, -3) = ""
                cell.Offset(0, -4) = ""
            End If
          
         Next cell
    End If
   
    If Not rng2 Is Nothing Then
        For Each cell In rng2
           If IsNumeric(cell.Value) And cell.Value > 0 Then
                 cell.Offset(0, 1) = cell / Range("G3")
                 cell.Offset(0, 2) = cell / Range("H3")
                 Range("E11") = Range("F11") * Range("G3")
                 Range("G11") = Range("E11") / Range("H3")
                 cell.Offset(0, -1) = Range("H3")
                 cell.Offset(0, -2) = Range("G3")
                 cell.Offset(0, -3) = Date
           Else
               cell.Offset(0, 0) = "0"
               cell.Offset(0, 1) = "0"
               cell.Offset(0, 2) = "0"
               cell.Offset(0, -1) = ""
               cell.Offset(0, -2) = ""
               cell.Offset(0, -3) = ""
           End If
        Next cell
   
    End If
    Application.EnableEvents = True 'reenable events
End Sub
Click to expand...
Cool !
It working perfectly !
Thank you very much !
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Using Defined name and/or direct formula in VBA
2
Replies
11
Views
418
Schturman
S
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
R
  • Question Question
Having Trouble getting this code in VBA to work. Attempting to download a list of PDFs
Replies
1
Views
125
6StringJazzer
6StringJazzer
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
304
Patriot2879
P
Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
902
bobsan42
bobsan42

Forum statistics

Threads
1,223,936
Messages
6,175,499
Members
452,650
Latest member
Tinfish

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top