Only run macro if cell is blank

B

blee4372

New Member
Joined
Apr 25, 2017
Messages
41
I have a macro that if a number is put into column F9:F80 it will puts a text in the next column. The issue I am have is I also track changes made to the sheet so when I click on any cell, the macro runs & even though there is already a number in column F & text in column G it will re-enter the text which is copy to my tracking sheet again & again.
Here is the code I am working with:

Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 Dim rng As Range
    
         Set rng = Range("F1:F80")
    For Each Cell In rng
           If Cell.Value = "22618-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION COVER F5"
           End If
           If Cell.Value = "22619-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP .063 5F"
           End If
           If Cell.Value = "22685-001" Then
           Cell.Offset(0, 1).Value = "SLIDE"
           End If
           If Cell.Value = "22687-000" Then
           Cell.Offset(0, 1).Value = "MOUNTING SHAFT"
           End If
           If Cell.Value = "22752-000" Then
           Cell.Offset(0, 1).Value = "DUO/TRIO LUER HUB NUT"
           End If
           If Cell.Value = "22639-000" Then
           Cell.Offset(0, 1).Value = "DI-LOC CLIP 4/9F"
           End If
           If Cell.Value = "22550-000" Then
           Cell.Offset(0, 1).Value = "HEMOSTASIS LUER LOCK ADAPTER BODY"
           End If
           If Cell.Value = "22963-000" Then
           Cell.Offset(0, 1).Value = "Mounting Shaft"
           End If
           If Cell.Value = "23493-000" Then
           Cell.Offset(0, 1).Value = "DISK SUTURE WIND (VIP)"
           End If
           If Cell.Value = "22743-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP"
           End If
           If Cell.Value = "23279-000" Then
           Cell.Offset(0, 1).Value = "C CLIP"
           End If
           If Cell.Value = "22538-001" Then
           Cell.Offset(0, 1).Value = "CAP, HEMO SF 12/16F"
           End If
           If Cell.Value = "22622-000" Then
           Cell.Offset(0, 1).Value = "CAP"
           End If
           If Cell.Value = "22960-004" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 8F"
           End If
           If Cell.Value = "22960-001" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 5F"
           End If
           If Cell.Value = "22733-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 12 PIN"
           End If
           If Cell.Value = "22732-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 4 PIN"
           End If
           If Cell.Value = "22853-000" Then
           Cell.Offset(0, 1).Value = "WIRE GUIDE"
     End If
    Next
With Target
sOldAddress = .Address(external:=True)
 
If .Count > 1 Then
 
vOldValue = "Multiple Cell Select"
sOldFormula = vbNullString
 
Else
 
vOldValue = .Value
If .HasFormula Then
sOldFormula = "'" & Target.Formula
Else
sOldFormula = vbNullString
End If
End If
End With
End Sub
 
Last edited by a moderator:

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Application.EnableEvents allows you to stop events while running a macro.

Application.EnableEvents = False

This might work.

Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
 Dim rng As Range
    
         Set rng = Range("F1:F80")
    For Each Cell In rng
           If Cell.Value = "22618-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION COVER F5"
           End If
           If Cell.Value = "22619-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP .063 5F"
           End If
           If Cell.Value = "22685-001" Then
           Cell.Offset(0, 1).Value = "SLIDE"
           End If
           If Cell.Value = "22687-000" Then
           Cell.Offset(0, 1).Value = "MOUNTING SHAFT"
           End If
           If Cell.Value = "22752-000" Then
           Cell.Offset(0, 1).Value = "DUO/TRIO LUER HUB NUT"
           End If
           If Cell.Value = "22639-000" Then
           Cell.Offset(0, 1).Value = "DI-LOC CLIP 4/9F"
           End If
           If Cell.Value = "22550-000" Then
           Cell.Offset(0, 1).Value = "HEMOSTASIS LUER LOCK ADAPTER BODY"
           End If
           If Cell.Value = "22963-000" Then
           Cell.Offset(0, 1).Value = "Mounting Shaft"
           End If
           If Cell.Value = "23493-000" Then
           Cell.Offset(0, 1).Value = "DISK SUTURE WIND (VIP)"
           End If
           If Cell.Value = "22743-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP"
           End If
           If Cell.Value = "23279-000" Then
           Cell.Offset(0, 1).Value = "C CLIP"
           End If
           If Cell.Value = "22538-001" Then
           Cell.Offset(0, 1).Value = "CAP, HEMO SF 12/16F"
           End If
           If Cell.Value = "22622-000" Then
           Cell.Offset(0, 1).Value = "CAP"
           End If
           If Cell.Value = "22960-004" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 8F"
           End If
           If Cell.Value = "22960-001" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 5F"
           End If
           If Cell.Value = "22733-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 12 PIN"
           End If
           If Cell.Value = "22732-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 4 PIN"
           End If
           If Cell.Value = "22853-000" Then
           Cell.Offset(0, 1).Value = "WIRE GUIDE"
     End If
    Next
With Target
sOldAddress = .Address(external:=True)
 
If .Count > 1 Then
 
vOldValue = "Multiple Cell Select"
sOldFormula = vbNullString
 
Else
 
vOldValue = .Value
If .HasFormula Then
sOldFormula = "'" & Target.Formula
Else
sOldFormula = vbNullString
End If
End If
End With
Application.EnableEvents = True
End Sub
 
Upvote 0
Oscar Cronquist said:
Application.EnableEvents allows you to stop events while running a macro.

Application.EnableEvents = False

This might work.

Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
 Dim rng As Range
    
         Set rng = Range("F1:F80")
    For Each Cell In rng
           If Cell.Value = "22618-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION COVER F5"
           End If
           If Cell.Value = "22619-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP .063 5F"
           End If
           If Cell.Value = "22685-001" Then
           Cell.Offset(0, 1).Value = "SLIDE"
           End If
           If Cell.Value = "22687-000" Then
           Cell.Offset(0, 1).Value = "MOUNTING SHAFT"
           End If
           If Cell.Value = "22752-000" Then
           Cell.Offset(0, 1).Value = "DUO/TRIO LUER HUB NUT"
           End If
           If Cell.Value = "22639-000" Then
           Cell.Offset(0, 1).Value = "DI-LOC CLIP 4/9F"
           End If
           If Cell.Value = "22550-000" Then
           Cell.Offset(0, 1).Value = "HEMOSTASIS LUER LOCK ADAPTER BODY"
           End If
           If Cell.Value = "22963-000" Then
           Cell.Offset(0, 1).Value = "Mounting Shaft"
           End If
           If Cell.Value = "23493-000" Then
           Cell.Offset(0, 1).Value = "DISK SUTURE WIND (VIP)"
           End If
           If Cell.Value = "22743-000" Then
           Cell.Offset(0, 1).Value = "BIFURCATION CAP"
           End If
           If Cell.Value = "23279-000" Then
           Cell.Offset(0, 1).Value = "C CLIP"
           End If
           If Cell.Value = "22538-001" Then
           Cell.Offset(0, 1).Value = "CAP, HEMO SF 12/16F"
           End If
           If Cell.Value = "22622-000" Then
           Cell.Offset(0, 1).Value = "CAP"
           End If
           If Cell.Value = "22960-004" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 8F"
           End If
           If Cell.Value = "22960-001" Then
           Cell.Offset(0, 1).Value = "CAP, ULTIMUM 5F"
           End If
           If Cell.Value = "22733-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 12 PIN"
           End If
           If Cell.Value = "22732-000" Then
           Cell.Offset(0, 1).Value = "CONNECTOR RECEPTACLE 4 PIN"
           End If
           If Cell.Value = "22853-000" Then
           Cell.Offset(0, 1).Value = "WIRE GUIDE"
     End If
    Next
With Target
sOldAddress = .Address(external:=True)
 
If .Count > 1 Then
 
vOldValue = "Multiple Cell Select"
sOldFormula = vbNullString
 
Else
 
vOldValue = .Value
If .HasFormula Then
sOldFormula = "'" & Target.Formula
Else
sOldFormula = vbNullString
End If
End If
End With
Application.EnableEvents = True
End Sub
Click to expand...

That worked...Thank you very much:biggrin:.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Enter a value in one cell and subtract from value in different cell and leave blank
Replies
0
Views
863
aurikyn
A
R
  • Question Question
VBA does not run
Replies
6
Views
972
rhmkrmi
R
F
  • Question Question
For Each cell In Range Copy/Paste Data to another Worksheet
Replies
3
Views
628
mumps
mumps
N
  • Locked
  • Question Question
Easy VBA syntax
Replies
2
Views
707
Fluff
Fluff
W
  • Question Question
VBA - problems with cell formatting multiple IF statements
2
Replies
10
Views
2K
Joe4
Joe4

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,623
Latest member
Techenthusiast

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