Run a Macro if cell in current Row has any value

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
477
Office Version
  1. 365
Platform
  1. Windows
Good morning! I have some code that deletes a row on my sheet. What I'm trying to do is run a macro (LogDeleteJob) if any value is found in a specific cell (in column AP) in the active row.

The code I added is this:

VBA Code:
    If Range(Cells(ActiveCell.Row, "AP")).Value = "*" Then
    Call LogDeleteJob
    Else
    End If

Sadly, I'm getting an error:

Run-time error '1004':
Method 'Range' of object '_Global' failed

Here's the complete macro:

VBA Code:
Sub DeleteRow()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Sheets("Calendar").Select
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("Are you sure you want to delete the highlighted Row?", vbYesNo + vbQuestion)
    If Ans = vbNo Then Exit Sub
   
    If Range(Cells(ActiveCell.Row, "AP")).Value = "*" Then
    Call LogDeleteJob
    Else
    End If
   
    ActiveSheet.Unprotect
    Range(Cells(Selection.Row - 1, 6).Address).Select
    ActiveCell = ActiveCell & "%"
    Rows(ActiveCell.Row + 1).Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Selection.Delete Shift:=xlUp
   
    Cells.FormatConditions.Delete
    Sheets("Template").Visible = True
    Sheets("Template").Select
    Range("Template").Select
    Selection.Copy
    Sheets("Calendar").Select
    Range("Calendar").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
    Sheets("Template").Visible = False
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
       
    'Add Shipping Instructions Hyperlinks
    Dim Cl As Range
    For Each Cl In Range("DateColumn", Range("B" & Rows.Count).End(xlUp))
    ActiveSheet.Hyperlinks.Add Anchor:=Cl, Address:="", SubAddress:= _
        Cl.Address, ScreenTip:="Click To Copy Shipping Instructions"
    Next Cl
       
    'Reformat
    Cells.FormatConditions.Delete
    Sheets("Template").Visible = True
    Sheets("Template").Select
    Range("Template").Select
    Selection.Copy
    Sheets("Calendar").Select
    Range("Calendar").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Template").Visible = False
   
    'Restore Hyperlink Color
    Dim hl As Hyperlink
    For Each hl In ActiveSheet.Hyperlinks
    hl.Range.Font.Color = RGB(0, 0, 255)
    Next
   
    'Restore Date Column Hyperlinks
    Application.Goto Reference:="DateColumn"
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
   
    'Restore Field Manager Column Hyperlinks
    Application.Goto Reference:="CalendarFieldManagersColumn"
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
   
    'Restore Calendar Link Row Hyperlinks
    Application.Goto Reference:="CalendarLinkRow"
    With Selection.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    End With
   
        Cells.Find(What:="%", After:=[a1], LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
       
    With ActiveCell
        If Right(.Value, 1) = "%" Then .Value = Left(.Value, Len(.Value) - 1)
    End With
   
    Range("B" & (ActiveCell.Row + 1)).Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
End Sub
 
Last edited:

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
This instead?

VBA Code:
If Cells(ActiveCell.row, "AP").Value <> vbNullString Then
Call LogDeleteJob
Else
End If
 
Upvote 0
Solution

Forum statistics

Threads
1,213,517
Messages
6,114,085
Members
448,548
Latest member
harryls

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