macro question

plost33

Well-known Member
Joined
Oct 2, 2008
Messages
866
I have the following code that work awesome!. the bottom section of this macro rounds time to the nearest quarter hour. it also takes the rounded time in column B and pastes that time into colunm A on the row below.

I works good. what i want to try and do is have it only copy that time and insert it in the row below, column A, if the row below is part of the same named range. the named range is "activityrange"


if the row below is not in that named range then i do not want it to copy and fill in the time from the row above.


heres the current code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Range("F9:F38")) Is Nothing Then
Application.EnableEvents = False
Select Case Target.Value
Case "Weather-NP": Target.Value = "WOW-NP"
Case "Bell Run-NP": Target.Value = "BR-NP"
Case "Survey/Diagnostics-A": Target.Value = "SD-A"
Case "Diamond Wire Cutter-A": Target.Value = "DWC-A"
Case "Diver Survey-A": Target.Value = "DS-A"
Case "Chop Saw-A": Target.Value = "CS-A"
Case "Deck Removal-A": Target.Value = "DR-A"
Case "Structure Removal-A": Target.Value = "SR-A"
Case "Excavate-A": Target.Value = "EXC-A"
Case "Strongback-I": Target.Value = "SB-I"
Case "Excavate-I": Target.Value = "EXC-I"
Case "Survey/Diagnostic-I": Target.Value = "SD-I"
Case "Annular Interval Tester-I": Target.Value = "AIT-I"
Case "Diver Survey-I": Target.Value = "DS-I"
Case "Conventional Hot Tap-I": Target.Value = "CHT-I"
Case "Direct Hot Tap-I": Target.Value = "DHT-I"
Case "Bleed & Kill-I": Target.Value = "BK-I"
Case "Shear Operation-I": Target.Value = "SO-I"
Case "Diamond Wire Cutter-I": Target.Value = "DWC-I"
Case "Chop Saw-I": Target.Value = "CS-I"
Case "Porta-Lathe-I": Target.Value = "PL-I"
Case "Wedding Cake-I": Target.Value = "WC-I"
Case "Install Well Head-I": Target.Value = "IWH-I"
Case "Survey/Diagnostic-TA": Target.Value = "SD-TA"
Case "Test Surf/Prod. Annulus-TA": Target.Value = "TCA-TA"
Case "Wireline Bottom-TA": Target.Value = "WL-B"
Case "Establish Injection/Circulation Bottom-TA": Target.Value = "EIR-B"
Case "Perf Bottom-TA": Target.Value = "PERF-B"
Case "Cement Bottom Plug-TA": Target.Value = "CMT-B"
Case "Test CMT Bottom Plug-TA": Target.Value = "TCP-B"
Case "Wireline Intermediate-TA": Target.Value = "WL-I"
Case "Establish Injection/Circulation Intermediate-TA": Target.Value = "EIR-I"
Case "Perf Intermediate-TA": Target.Value = "PERF-I"
Case "Cement Intermediate Plug-TA": Target.Value = "CMT-I"
Case "Diver Survey-TA": Target.Value = "DS-TA"
Case "Wireline Surface-TA": Target.Value = "WL-S"
Case "Establish Injection/Circulation Surface-TA": Target.Value = "EIR-S"
Case "Perf Surface-TA": Target.Value = "PERF-S"
Case "Cement Surface Plug-TA": Target.Value = "CMT-S"
Case "Structure Removal-PA": Target.Value = "SR-PA"
Case "Install Tester-TA": Target.Value = "AIT-TA"
Case "Grout Csg Annulus-TA": Target.Value = "GCA-TA"
Case "Cut & Pull Csg-PA": Target.Value = "CPC-PA"
Case "Debris Clearance-PA": Target.Value = "DC-PA"
Case "Survey/Diagnostic-PA": Target.Value = "SD-PA"
Case "Deck Removal-PA": Target.Value = "DR-PA"
Case "Diver Survey-PA": Target.Value = "DS-PA"
Case "Mesotech-PA": Target.Value = "MESO-PA"
Case "Trawling Site Clearance-PA": Target.Value = "TSC-PA"
Case "Exit Survey-PA": Target.Value = "ES-PA"
Case "Pipeline Survey-PA": Target.Value = "PS-PA"
Case "Mechanical Downtime-NP": Target.Value = "MDT-NP"
Case "Vessel Downtime-NP": Target.Value = "VDT-NP"
Case "Regulatory-NP": Target.Value = "REG-NP"
Case "Mobe/Demobe-NP": Target.Value = "MDM-NP"
Case "Health Safety Environment-NP": Target.Value = "HSE-NP"
Case "Waiting on Orders-NP": Target.Value = "WOO-NP"
Case "Other-NP": Target.Value = "OTHER-NP"
End Select
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("A9:B60")) Is Nothing Then
If Not IsNumeric(Target.Value) Then Exit Sub
Application.EnableEvents = False
Me.Unprotect Password:="techedit"
Target.Value = WorksheetFunction.Floor(Target.Value + 7.5 / 1440, 15 / 1440)
If Target.Column = 2 Then
With Target.Offset(1, -1)
.NumberFormat = "hh:mm"
.Value = Target.Value
End With
End If
Me.Protect Password:="techedit"
Application.EnableEvents = True
End If
End Sub



Hope someone can help.
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Have a look at Intersect...

eg

Code:
If Not Intersect(Target.Offset(1,0),Range("activityrange")) Is Nothing Then
...do stuff
End If
 
Upvote 0
change:

Rich (BB code):
If Target.Column = 2 Then

to

Rich (BB code):
If Target.Column = 2 And Not Intersect(Target.Offset(1, 0), Range("activityrange")) Is Nothing Then

Please also make use of CODE Tags going forward... add [*CODE*] before first line of VBA and [/*CODE*] after last line of VBA code
(without the asterisks)
 
Upvote 0

Forum statistics

Threads
1,216,073
Messages
6,128,641
Members
449,461
Latest member
kokoanutt

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