New VBA codes prevent old ones from working?

alisoncleverly

New Member
Joined
Feb 20, 2020
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
Hi everyone,

I have an Excel file that tracks engine status from Sales and Production departments.

Here is a summary of my columns:
  • Columns A - M in the workbook contain data necessary to deem the engine status
  • Columns N - AS are used to track engine status with the following column order: Sales, Production, Day 1, Status. That repeats till Day 8 (i.e. Sales, Production, Day 8, Status). Every "Status" column has a formula to return either "Sales" or "Production" based on the values in Sales and Production columns
  • Column AS is called "Status" in which the formula would return the same value Column AR has
  • Column AU is "Comments"
  • Column AV is "MB51 Shipped"
  • Column AW is ""FPS?"
  • Column AX is "Plant"
  • Column AY is "Title Transfer"

I was trying to get the Macro to do: If "Shipped" in column AV, then the empty remaining Days will have "Rollup" in both Sales and Production columns.

Can you please advise why after adding the following lines to "Master Worksheet", the Macro no longer returns values in Day columns (per the IF statements from Module) though it did before adding those codes and please also kindly suggest me a way to get it work?

See attached print screen where the Day cell is empty when I put "Shipped" in column AV, which it was supposed to return "Rollup" per the IF statement.

VBA Code:
Dim lastColumn As Long
Dim counter As Long

Application.EnableEvents = False

' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then

    ' Get last column based on first row
    lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column

    ' Check all cells in row and find matches for Sales and Production
    For counter = 1 To lastColumn

        ' Check if header match and cell is not empty
        If (Me.Cells(1, counter).Value = "Sales" or Me.Cells(1, counter).Value = "Production") And Me.Cells(Target.Row, counter).Value = vbNullString Then

            Me.Cells(Target.Row, counter).Value = "Rollup"

        End If

    Next counter

End If

Application.EnableEvents = True

This is what I currently have in "Master Worksheet":

VBA Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, r1 As Range
    
    Dim lastColumn As Long
    Dim counter As Long

Application.EnableEvents = False

' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then

    ' Get last column based on first row
    lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column

    ' Check all cells in row and find matches for Sales and Production
    For counter = 1 To lastColumn

        ' Check if header match and cell is not empty
        If (Me.Cells(1, counter).Value = "Sales" Or Me.Cells(1, counter).Value = "Production") And Me.Cells(Target.Row, counter).Value = vbNullString Then

            Me.Cells(Target.Row, counter).Value = "Rollup"

        End If

    Next counter

End If

Application.EnableEvents = True
    
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales2).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales3).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)
    
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales4).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales5).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales6).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)
    
    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales7).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)

    Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales8).Resize(, 3))
    If Not r Is Nothing Then Call DoCells(r)


End Sub


Private Sub DoCells(r As Range)
    Dim r1 As Range
    For Each r1 In r.Cells
        With r1
            Select Case .Column
                Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
                    Call MasterChange(.Resize(1, 3))
                Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
                    Call MasterChange(.Offset(0, -1).Resize(1, 3))
                Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
                    Call MasterChange(.Offset(0, -2).Resize(1, 3))
            End Select
        End With
    Next
End Sub

And this is what I have in my Module:

VBA Code:
Option Explicit

Public Const colSales1 As Long = 14
Public Const colProduction1 As Long = 15
Public Const colDay1 As Long = 16
Public Const colStatus1 As Long = 17

Public Const colSales2 As Long = 18
Public Const colProduction2 As Long = 19
Public Const colDay2 As Long = 20
Public Const colStatus2 As Long = 21

Public Const colSales3 As Long = 22
Public Const colProduction3 As Long = 23
Public Const colDay3 As Long = 24
Public Const colStatus3 As Long = 25

Public Const colSales4 As Long = 26
Public Const colProduction4 As Long = 27
Public Const colDay4 As Long = 28
Public Const colStatus4 As Long = 29

Public Const colSales5 As Long = 30
Public Const colProduction5 As Long = 31
Public Const colDay5 As Long = 32
Public Const colStatus5 As Long = 33

Public Const colSales6 As Long = 34
Public Const colProduction6 As Long = 35
Public Const colDay6 As Long = 36
Public Const colStatus6 As Long = 37

Public Const colSales7 As Long = 38
Public Const colProduction7 As Long = 39
Public Const colDay7 As Long = 40
Public Const colStatus7 As Long = 41

Public Const colSales8 As Long = 42
Public Const colProduction8 As Long = 43
Public Const colDay8 As Long = 44
Public Const colStatus8 As Long = 45

Public Const colStatus9 As Long = 46


Sub UpdateMaster()
    Dim r As Range
    Dim wsMaster As Worksheet, wsSAP As Worksheet

    If MsgBox("Do you want to update 'Master Worksheet' from 'SAP'?", vbYesNo + vbQuestion + vbDefaultButton2, "Update Master") = vbNo Then
        Exit Sub
    End If

    Set wsMaster = Worksheets("Master Worksheet")
    Set wsSAP = Worksheets("SAP")

    'IMPORTANT -- turn off events
    Application.EnableEvents = False

    'get rid of old data
    wsMaster.Cells.Clear

    'copy SAP
    wsSAP.Cells(1, 1).CurrentRegion.Copy wsMaster.Cells(1, 1)

    'add formulas - double "" inside string to get one
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus1)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(O2=N2,""Sales/Production"",IF(P2=O2,""Production"",IF(P2=N2,""Sales"","""")))"

    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus2)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(S2=R2,""Sales/Production"",IF(T2=S2,""Production"",IF(T2=R2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus3)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(W2=V2,""Sales/Production"",IF(X2=W2,""Production"",IF(X2=V2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus4)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(Z2=AA2,""Sales/Production"",IF(AB2=AA2,""Production"",IF(AB2=Z2,""Sales"","""")))"

    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus5)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(AD2=AE2,""Sales/Production"",IF(AF2=AE2,""Production"",IF(AF2=AD2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus6)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(AH2=AI2,""Sales/Production"",IF(AJ2=AI2,""Production"",IF(AJ2=AH2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus7)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(AL2=AM2,""Sales/Production"",IF(AN2=AM2,""Production"",IF(AN2=AL2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus8)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=IF(AP2=AQ2,""Sales/Production"",IF(AR2=AQ2,""Production"",IF(AR2=AP2,""Sales"","""")))"
    
    Set r = wsMaster.Cells(1, 1).CurrentRegion.Columns(colStatus9)
    Set r = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
    r.Formula = "=AS2"

    'IMPORTANT -- turn on events
    Application.EnableEvents = True

End Sub

Sub ClearMaster()
    Dim ws As Worksheet
    Set ws = Workbooks("SampleReport03.xlsm").Sheets("Master Worksheet")
    ws.Rows("2:" & Rows.Count).Clear
End Sub

Sub ClearSAP()
    Dim ws As Worksheet
    Set ws = Workbooks("SampleReport.xlsm").Sheets("SAP")
    ws.Rows("2:" & Rows.Count).ClearContents
End Sub


Public Sub MasterChange(SPD As Range)
    Dim rSales As Range
    Dim rProduction As Range
    Dim rDay As Range
    
    Set rSales = SPD.Cells(1, 1)
    Set rProduction = SPD.Cells(1, 2)
    Set rDay = SPD.Cells(1, 3)
    
    Application.EnableEvents = False
    If rSales = "Rollup" And rProduction = "Rollup" Then
        rDay = "Rollup"
    ElseIf rSales = "Rollup" And rProduction = "Green" Then
        rDay = "Green"
    ElseIf rSales = "Rollup" And rProduction = "Yellow" Then
        rDay = "Yellow"
    ElseIf rSales = "Rollup" And rProduction = "Red" Then
        rDay = "Red"
    ElseIf rSales = "Rollup" And rProduction = "Overdue" Then
        rDay = "Overdue"
    ElseIf rSales = " " And rProduction = " " Then
        rDay.ClearContents
    End If
    Application.EnableEvents = True
End Sub

Thank you very much. Any help is really appreciated and I apologise for the long codes since I couldn't post a sample here.
 

Attachments

  • Capture.PNG
    Capture.PNG
    12.1 KB · Views: 13

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Welcome to the Forum!

There's nothing immediately obviously in the new code snippet which would change the way the old code worked. Are you sure it's the new code causing the problem, and not just some other change in the layout for the problem run?

It's going to be difficult to replicate the problem without knowing your complete layout. Are you perhaps able to post a sample workbook with non-confidential data?

Otherwise I can only suggest putting in a few strategically placed breakpoints and stepping through to see which bits of code are running, and what they are doing.

I don't think it's relevant to the problem, but this Sub looks a little odd:

VBA Code:
Private Sub DoCells(r As Range)
    Dim r1 As Range
    For Each r1 In r.Cells
        With r1
            Select Case .Column
                Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
                    Call MasterChange(.Resize(1, 3))
                Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
                    Call MasterChange(.Offset(0, -1).Resize(1, 3))
                Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
                    Call MasterChange(.Offset(0, -2).Resize(1, 3))
            End Select
        End With
    Next
End Sub

It looks like r is always 1x3, and given that Sales, Production and Day are always in successive columns, won't this call MasterChange three times using the same range?
 
Upvote 0
Welcome to the Forum!

There's nothing immediately obviously in the new code snippet which would change the way the old code worked. Are you sure it's the new code causing the problem, and not just some other change in the layout for the problem run?

It's going to be difficult to replicate the problem without knowing your complete layout. Are you perhaps able to post a sample workbook with non-confidential data?

Otherwise I can only suggest putting in a few strategically placed breakpoints and stepping through to see which bits of code are running, and what they are doing.

I don't think it's relevant to the problem, but this Sub looks a little odd:

VBA Code:
Private Sub DoCells(r As Range)
    Dim r1 As Range
    For Each r1 In r.Cells
        With r1
            Select Case .Column
                Case colSales1, colSales2, colSales3, colSales4, colSales5, colSales6, colSales7, colSales8
                    Call MasterChange(.Resize(1, 3))
                Case colProduction1, colProduction2, colProduction3, colProduction4, colProduction5, colProduction6, colProduction7, colProduction8
                    Call MasterChange(.Offset(0, -1).Resize(1, 3))
                Case colDay1, colDay2, colDay3, colDay4, colDay5, colDay6, colDay7, colDay8
                    Call MasterChange(.Offset(0, -2).Resize(1, 3))
            End Select
        End With
    Next
End Sub

It looks like r is always 1x3, and given that Sales, Production and Day are always in successive columns, won't this call MasterChange three times using the same range?

Hi, sorry I can't really say anything about the codes you mentioned because they weren't written by me but my former colleague. We used to have 2 separate Macro-enabled files because somehow putting all the codes in 1 file always caused the crash (even now, one of the files has a ridiculous amount of codes).

This is the link to the old file (without the codes for all the engine calculations that you'll see in the New file below).
Old File

We have 2 files A and B. File A would be used for deeming engine status, then someone would have to copy the data there to file B. File B is where we have a ridiculous amount of codes to calculate and extract a lot of info (see New File's module for sample). Still, the old File A would always give error messages whenever we changed the value of IF statements, which was the reason why we wanted a new and more productive file.

And this is the link to the new file where some IT guy helped us with. He said he didn't like the old codes and sort of changed a lot of things:
New File

I tried removing the following codes from the new file's Master Worksheet and everythign works okay but then again, it won't automate the Rollup status I want:

VBA Code:
Dim lastColumn As Long
Dim counter As Long

Application.EnableEvents = False

' Check if header is "MB51 Shipped"
If Me.Cells(1, Target.Column).Value = "MB51 Shipped" Then

    ' Get last column based on first row
    lastColumn = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column

    ' Check all cells in row and find matches for Sales and Production
    For counter = 1 To lastColumn

        ' Check if header match and cell is not empty
        If (Me.Cells(1, counter).Value = "Sales" or Me.Cells(1, counter).Value = "Production") And Me.Cells(Target.Row, counter).Value = vbNullString Then

            Me.Cells(Target.Row, counter).Value = "Rollup"

        End If

    Next counter

End If

Application.EnableEvents = True

Please let me know if you need more info. Thanks a lot!
 
Upvote 0
And this is the link to the new file where some IT guy helped us with. He said he didn't like the old codes and sort of changed a lot of things

IT guys have their place, but this code could be written more efficiently by someone with more VBA skills. Sorry, that won't be me - there's too much here.

I have ignored the Old File. Clearly the code and layout have changed markedly in New File.

Your immediate problem is that if you change cell AV2, the Worksheet_Change code won't do anything. (And this has nothing to do with the new code snippet.) In Sub Worksheet_Change, there are several tests for which cells have changed, e.g.

VBA Code:
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
If Not r Is Nothing Then Call DoCells(r)

This will call DoCells if you change a cell in column 14 (because colSales1 = 14) or in the following two columns 15 and 16, i.e. columns N:P where you have Sales, Production, Day1. There are similar tests for the column triplets for Day2, Day3 ... Day8. But there is no test for column 48 (column AV), so no more code executes.

What do you want the code to do if you change AV2. Perhaps loop through all, i.e. Day1, Day 2 .. Day 8?

By the way, my observation in Post#7 about the Sub DoCells is correct. The code is a complicated way of calling MasterChange three times on the same 1x3 range. As MasterChange always tests the first two values and changes the third, the three iterations will do exactly the same thing.
 
Upvote 0
IT guys have their place, but this code could be written more efficiently by someone with more VBA skills. Sorry, that won't be me - there's too much here.

I have ignored the Old File. Clearly the code and layout have changed markedly in New File.

Your immediate problem is that if you change cell AV2, the Worksheet_Change code won't do anything. (And this has nothing to do with the new code snippet.) In Sub Worksheet_Change, there are several tests for which cells have changed, e.g.

VBA Code:
Set r = Intersect(Target, Cells(1, 1).CurrentRegion, Columns(colSales1).Resize(, 3))
If Not r Is Nothing Then Call DoCells(r)

This will call DoCells if you change a cell in column 14 (because colSales1 = 14) or in the following two columns 15 and 16, i.e. columns N:P where you have Sales, Production, Day1. There are similar tests for the column triplets for Day2, Day3 ... Day8. But there is no test for column 48 (column AV), so no more code executes.

What do you want the code to do if you change AV2. Perhaps loop through all, i.e. Day1, Day 2 .. Day 8?

By the way, my observation in Post#7 about the Sub DoCells is correct. The code is a complicated way of calling MasterChange three times on the same 1x3 range. As MasterChange always tests the first two values and changes the third, the three iterations will do exactly the same thing.
Thank you for your insights but I have found the solution where I removed
VBA Code:
Application.EnableEvents = False

and

VBA Code:
Application.EnableEvents = True

Everything works fine now. Thanks again!
 
Upvote 0
Thank you for your insights but I have found the solution where I removed
VBA Code:
Application.EnableEvents = False
and

VBA Code:
Application.EnableEvents = True
Everything works fine now. Thanks again!
It is important to understand exactly what this code is doing, as removing it could have unintended or dire consequences!!!

A "Worksheet_Change" procedure is a special kind of VBA code known as an "event procedure". This is VBA code that runs automatically upon some event happening. You need to be very careful with this type of code. Since it is triggered automatically, if you are not careful, you can get caught in an infinite loop.

For example, a procedure like this would do just that:
***WARNING DO NOT RUN***
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Range("A1") = Range("A1") + 1
End Sub
This is a procedure that runs automatically when a cell's value is manually changed on the sheet.
However, the code itself is changing the value of A1, by adding 1 to it. So that itself, triggers the code to run again, which changes the value, which triggers the code to run again, etc.
and you are caught in an endless loop!!! Very bad!!!

So, the way we gert around that is we can temporarily disable our "events" from firing by adding a command in our VBA code like this:
Application.EnableEvents = False

So, whenever we have a Worksheet_Change event procedure which updates values on the sheet, if those changes would meet the criteria to trigger the code to run again, you typically will see that line of code to disable events, then you will see the lines of code that update the data, and then you will see a line of code to re-enable events again like this:
Application.EnableEvents = True

Sometimes, when people are testing and debugging code, they get in trouble if their code gets interrupted between the Application.EnableEvents = False and the Application.EnableEvents = True lines, becaaue then events are in a disabled state and their automated code will not work (and they cannot figure out why their code isn't working!).

If that happens, then can re-enable it by manually running a simple little procedure to turn it back on like this:
VBA Code:
Sub ReEnableEvents()
    Application.EnableEvents = True
End Sub
So, moral of the story, if you remove those lines, be sure that your code isn't going to end up calling itself and getting caught in an endless loop!
Otherwise, you will need to keep those lines in there.
 
Upvote 0

Forum statistics

Threads
1,214,375
Messages
6,119,170
Members
448,870
Latest member
max_pedreira

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