Private sub to Normal sub

V

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
139
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
 
Sort by date Sort by votes
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:
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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".
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
190
bobsan42
bobsan42
S
  • Solved
Combine two codes in one worksheet change events
Replies
3
Views
248
Alex Blakenburg
A
larinda4
  • Question
VBA: Send Outlook Email & Attach PDF
Replies
1
Views
99
Trebor76
T
M
  • Question
Find and return yes/no
Replies
3
Views
312
Osvaldo Palmeiro
O
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
251
Gajendran Yadhav
G

Forum statistics

Threads
1,214,559
Messages
6,120,194
Members
448,951
Latest member
jennlynn

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