Private sub to Normal sub

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
85
Office Version
  1. 2016
Platform
  1. Windows
Hi Friends,

I have below private macro(in the particular sheet) which works to update Timestamp in column B for every formula driven data change in column A cells . Macro works fine, but does not let excel close (reopens when closed) as well as causes exceptions to run Python script on same excel file for some other data needs. I have many other macros in same file.but they do not cause any excel/python issues

My question is can we write a normal sub/module macro to replace below macro but have the same functionality(update Timestamp in column B for every formula driven data change in column A cells - Note the data chnage in column A is formula driven, not manual input)


Private Sub Worksheet_Calculate()
Dim Cell As Range
For Each Cell In Range("A1:A142")
If Cell.Value <> Cell.Offset(0, 8).Value Then
Cell.Offset(0, 1).Value = Now
Cell.Offset(0, 8).Value = Cell.Value
End If
Next
Columns("B:B").EntireColumn.AutoFit
End Sub
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
85
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I am trying to modify above code by adding 3 more "OR "steps(marked in red text-any one of three steps will be true at a time for cell). Retaining earlier code independent functionality as it is (black color text)

It is giving compile error "Next without For". Please advise

VBA Code:
Private Sub Worksheet_Calculate()
If Time >= TimeSerial(15, 29, 30) Then Exit Sub
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Range("A1:A142")
    If Cell.Value <> Cell.Offset(0, 8).Value Then
        Cell.Offset(0, 1).Value = Now
        Cell.Offset(0, 8).Value = Cell.Value
        Cell.Offset(0, 3).Value = Cell.Offset(0, 9).Value
    Next
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "LR" Then
        Cell.Offset(0, 11).Value = Cell.Offset(0, 15).Value + 1
    Next
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "NR" Then
        Cell.Offset(0, 12).Value = Cell.Offset(0, 16).Value + 1
    Next
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "HR" Then
        Cell.Offset(0, 13).Value = Cell.Offset(0, 17).Value + 1
    End If
Next
Columns("B:B").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Basic rule regarding For ... and If... statements, Each For requires a matching Next, Each block If requires a matching End If. a block If is like:
VBA Code:
If Range("A1").Value = Range("B1").Value Then
    MsgBox "Equal"
End if
But if the statement is wriiten on one line like:
VBA Code:
If Range("A1").Value = Range("B1").Value Then  MsgBox "Equal"
It does not require an End If.
Try this edited version.
VBA Code:
Private Sub Worksheet_Calculate()
If Time >= TimeSerial(15, 29, 30) Then Exit Sub
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Range("A1:A142")
    If Cell.Value <> Cell.Offset(0, 8).Value Then
        Cell.Offset(0, 1).Value = Now
        Cell.Offset(0, 8).Value = Cell.Value
        Cell.Offset(0, 3).Value = Cell.Offset(0, 9).Value
    End If
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "LR" Then
        Cell.Offset(0, 11).Value = Cell.Offset(0, 15).Value + 1
    End If
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "NR" Then
        Cell.Offset(0, 12).Value = Cell.Offset(0, 16).Value + 1
    End If
    If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "HR" Then
        Cell.Offset(0, 13).Value = Cell.Offset(0, 17).Value + 1
    End If
Next
Columns("B:B").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
85
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hi,

Additional if conditions freeze screen for 4-5 secs.everytime .. was smooth when there was only 1 condition in above macro...Not sure if that can be made smooth so that my other copy paste macros within workbook(timed every 1 sec-now delayed 4-5 secs due to above) can do their job unhindered ...
Regards,
PK
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Maybe this is what you were trying to do:

VBA Code:
Private Sub Worksheet_Calculate()
If Time >= TimeSerial(15, 29, 30) Then Exit Sub
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Range("A1:A142")
    If Cell.Value <> Cell.Offset(0, 8).Value Then
        Cell.Offset(0, 1).Value = Now
        Cell.Offset(0, 8).Value = Cell.Value
        Cell.Offset(0, 3).Value = Cell.Offset(0, 9).Value   
    ElseIf Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "LR" Then
        Cell.Offset(0, 11).Value = Cell.Offset(0, 15).Value + 1   
    ElseIf Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "NR" Then
        Cell.Offset(0, 12).Value = Cell.Offset(0, 16).Value + 1  
    ElseIf Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "HR" Then
        Cell.Offset(0, 13).Value = Cell.Offset(0, 17).Value + 1
    End If
Next
Columns("B:B").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
85
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hi,
Elseif conditions for some reason are not working for same dependent columns "Cell.Value <> Cell.Offset(0, 8).Value" and macro stops on 1st if condition only....and do not check for any of next 3 Elseif conditions. In above case, along with main if condition...any of 3 Elseif conditions will always be true. I tried changing dependent condition columns to tie columns 10 and 14 columns and its working fine..will check smoothness of excel macros today.....Regards..PK

Private Sub Worksheet_Calculate()
If Time <= TimeSerial(7, 40, 0) Or Time >= TimeSerial(15, 29, 30) Then Exit Sub
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Range("A1:A142")
If Cell.Value <> Cell.Offset(0, 9).Value Then
Cell.Offset(0, 1).Value = Now
Cell.Offset(0, 9).Value = Cell.Value
Cell.Offset(0, 3).Value = Cell.Offset(0, 8).Value
Cell.Offset(0, 10).Value = Cell.Offset(0, 10).Value + 1
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "LR" Then
Cell.Offset(0, 11).Value = Cell.Offset(0, 11).Value + 1
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "NR" Then
Cell.Offset(0, 12).Value = Cell.Offset(0, 12).Value + 1
ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "HR" Then
Cell.Offset(0, 13).Value = Cell.Offset(0, 13).Value + 1
End If
Next
Columns("B:B").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
The OP stated that three "OR" steps were being added. The ElseIf acts as an "Or" operator. The first condition to = True will cause it to exit the If statement. If More than one contition can exist, then the added statement would not be "Or", they would be "And" So it needs clarification as to which statements are "Or and which are "And".
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
85
Office Version
  1. 2016
Platform
  1. Windows
My be I was not clear enough..My apologies..here it goes..

Logic -1st condition is True and (second or third or Fourth condition is True)

In addition to first condition being True

For Each Cell In Range("A1:A142")
If Cell.Value <> Cell.Offset(0, 9).Value Then
Cell.Offset(0, 1).Value = Now
Cell.Offset(0, 9).Value = Cell.Value
Cell.Offset(0, 3).Value = Cell.Offset(0, 8).Value
Cell.Offset(0, 10).Value = Cell.Offset(0, 10).Value + 1


Above condition being true, any 1 of below 3 conditions will be true for each cell range
If Cell.Value <> Cell.Offset(0, 9).Value
And Cell.Value = "LR" Then
Cell.Offset(0, 11).Value = Cell.Offset(0, 11).Value + 1
If Cell.Value <> Cell.Offset(0, 9).Value And Cell.Value = "NR" Then
Cell.Offset(0, 12).Value = Cell.Offset(0, 12).Value + 1
If Cell.Value <> Cell.Offset(0, 9).Value And Cell.Value = "HR" Then
Cell.Offset(0, 13).Value = Cell.Offset(0, 13).Value + 1

Regards,
PK
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
This according to the logic in Post # 19
VBA Code:
Private Sub Worksheet_Calculate()
If Time >= TimeSerial(15, 29, 30) Then Exit Sub
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Range("A1:A142")
    If Cell.Value <> Cell.Offset(0, 8).Value Then
        Cell.Offset(0, 1).Value = Now
        Cell.Offset(0, 8).Value = Cell.Value
        Cell.Offset(0, 3).Value = Cell.Offset(0, 9).Value
        If Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "LR" Then
            Cell.Offset(0, 11).Value = Cell.Offset(0, 15).Value + 1
        ElseIf Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "NR" Then
            Cell.Offset(0, 12).Value = Cell.Offset(0, 16).Value + 1
        ElseIf Cell.Value <> Cell.Offset(0, 8).Value And Cell.Value = "HR" Then
            Cell.Offset(0, 13).Value = Cell.Offset(0, 17).Value + 1
        End If
    End If
Next
Columns("B:B").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,847
Messages
5,598,435
Members
414,238
Latest member
juxion

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
Top