Combine two codes in one worksheet change events

S

Schturman

New Member
Joined
May 28, 2022
Messages
46
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

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
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

Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
232
bobsan42
bobsan42
larinda4
  • Question
VBA: Send Outlook Email & Attach PDF
Replies
1
Views
144
Trebor76
T
The Ruff Report
  • Question
Add multiple attachments from email list
Replies
1
Views
288
Trebor76
T
G
  • Question
Macro Code Help for multiple worksheets.
Replies
1
Views
183
Georgiboy
Georgiboy
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
358
Agnarr
Agnarr

Forum statistics

Threads
1,215,124
Messages
6,123,184
Members
449,090
Latest member
bes000

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