I have an excel where I have a column called roles with text like:
Then I have another column where I have name and reference this first column like:
My question is, there is a way to assign first column to second one, I.E: if I click on GetSalesOrderItems = 1,2,4,5 cell, autoclick cells 1,2,4 and 5? is that possible? How can I do a reference of second column to first column? Regards
Here's a quick example of doing something like this in VBA.
Assuming you have a sheet like:
You can add code to the sheet (open your VBE, double click the worksheet in the Project pane and paste in this code):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Worksheet_BeforeDoubleClick() fires whenever a double click is detected on this worksheet.
'Our thing being double clicked is in B1, so lets make sure the double click came from there by testing `Target`
If Not Intersect(Target, Range("B1")) Is Nothing Then
'Must be B1... so let's load the numbers into an array
Dim numArray As Variant
numArray = Split(Split(Target, "=")(1), ",")
'We are going to assume we already have some highlighted cells. Unhighlight this first
i = 1
Do Until Cells(i, 1).Value = ""
Cells(i, 1).Font.Bold = False
'increment for the next loop
i = i + 1
Loop
'Now we can loop this array and search for it in Column A
For Each num In numArray
'Loop through column A
i = 1
Do Until Cells(i, 1).Value = ""
'test if it shares a value
If num = Split(Cells(i, 1).Value, "=")(1) Then
'Make the cell bold or something
Cells(i, 1).Font.Bold = True
End If
'increment for the next loop
i = i + 1
Loop
Next num
End If
End Sub
That's going to bold any cells in Column A that share a value of the cell in Column B (When you double click on that cell).
No doubt you will need to edit this to get what you need, but this should get you in the ballpark.
Related
I am attempting to create a macro button that does one thing in two steps. This is for a progress tracker, if a task is marked completed in column G, then I need the row hidden.
That command I have completed below, however step two of this is if the value in column c "Name" is hidden (based on the first command) then I need all other values in column C, equal to the values of the hidden rows, hidden as well. The goal of this is to return all items actively in progress by eliminating any names in row C that have a "completed" task under them.
'Step 1: (Works to hide completed rows)
Sub HideCompletes()
For Each cell In ActiveSheet.Range("G5:G200") 'would love to have this work for all cells after G5, but not sure how to acomplish that either
If cell.Value = "Completed" Or cell.Value = "" Then
cell.EntireRow.Hidden = True
End If
Next cell
'Step 2: (non functional idea)
For Each cell In ActiveSheet.Range("G5:G200")
If cell.RowHeight = 0 And cell.Value In ActiveSheet.Range("C5:C200")
cell.EntireRow.Hidden = True
End If
Next cell
End Sub
Try this:
Sub HideCompletes()
' first find the last row in the spreadsheet that has data
Dim lastrow As Long
lastrow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
' now loop through the cells in G and hide them if they are completed
For Each cell In ActiveSheet.Range("G5:G" & lastrow)
If cell.Value = "Completed" Or cell.Value = "" Then
cell.EntireRow.Hidden = True
' get the value from column C for that row
Dim hiddenvalue As Variant
hiddenvalue = ActiveSheet.Range("C" & cell.Row)
' now loop through the cells in C and hide them if they match our hidden value
' the value 0 will match an empty cell so we need to check both conditions
For Each othercell In ActiveSheet.Range("C5:C" & lastrow)
If othercell.Value <> "" And othercell.Value = hiddenvalue Then
othercell.EntireRow.Hidden = True
End If
Next othercell
End If
Next cell
End Sub
I think it does what you want. If cell in G is "Completed" or "" then it hides that row. Then after that it loops through all the rows and hides any that have the same value in column C as the row that was hidden originally.
User form data is overwriting itself rather than entering row by row.
I have tried different combinations of ActiveCell, Cell, Set, and Range. Pulling code from the internet for somewhat similar purposes and tweaking was unsuccessful.
Private Sub CheckOut_Click()
Dim xCell As Range
For Each xCell In ActiveSheet.Columns(1).Cells
If Len(xCell) = 0 Then
xCell.Select
Exit For
End If
Next
Range("B2").Value = TextBox1.Text
Range("C2").Value = TextBox2.Text
Range("D2").Value = ("OUT")
TextBox1 = ""
TextBox2 = ""
End Sub
I want each submission in the user form to populate a new row creating a list. What is actually happening is everything writes to row 2.
Please give feed back with down votes and flags.
Dim ws as Worksheet
Dim freeRow as long
Set ws = ActiveSheet 'Is it really necessary to use the active sheet?
freeRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row + 1 'End(xlUp) jumps to the next free cell
ws.Cells(freeRow, 2) = TextBox1.Text
ws.Cells(freeRow, 3) = TextBox2.Text
ws.Cells(freeRow, 4) = "OUT"
TextBox1.Text = ""
TextBox2.Text = ""
It is usually considered that ".select" is bad practice since it can lead to weird/nasty errors - rather use variables (this makes your code more reusable and less error prone!)
Your code
Private Sub CheckOut_Click()
Dim xCell As Range
' Loop through cells of first column. You can also use "A" instead of 1.
' Since you haven't used ActiveSheet with the ranges, it is also not
' needed here. It would be better to specify the worksheet e.g. "Sheet1".
For Each xCell In ActiveSheet.Columns(1).Cells
' Check if length of value of current cell is 0.
' Usually 'If xCell = "" Then' is used.
If Len(xCell) = 0 Then
' Select (Go to) current cell. What for?
xCell.Select
' Exit the For Next loop. Will jump to 'Range("B2") ...'
Exit For
End If
Next
' Write certain values to cells of 2nd row.
Range("B2").Value = TextBox1.Text
Range("C2").Value = TextBox2.Text
Range("D2").Value = ("OUT")
' Clear the Text boxes.
TextBox1 = ""
TextBox2 = ""
End Sub
In a nutshell, the code will check for an empty cell in column 1, will select the found cell (for an unknown reason) and will write some data to certain cells in the 2nd row and clear the values of the text boxes.
Questions
You loop through column 1. When an empty cell is found, do you want to write the values to columns B-D in the first found empty row or to columns B-D in the same row where the empty cell in column 1 was found?
Empty or Same?
Do you want this to happen only once, when an empty cell was found or for all found empty cells in the used range of column 1?
Once or All?
The used range of column 1 would be from e.g. A1 or which cell you choose to the last used cell.
You can manually determine the last used cell by selecting the last cell of column 1 ("A") and holding RIGHT CTRL and pressing UP. This will be done in the code, but it is just for you to have a visual of what will be checked for empty cells if you want to find more of them.
A1 or ...?
You should address these questions in your question which you can modify by using the edit button below it.
Possible Solution
Private Sub CheckOut_Click()
Dim xCell As Range ' Current Cell in Column "A"
Dim FER As Long ' First Empty Row
' Loop through cells of Column "A".
For Each xCell In Columns("A")
' Check if value of Current Cell is "".
If xCell.Value = "" Then
' Select Current Cell. If necessary.
xCell.Select
' Calculate First Empty Row using column "B".
FER = Range("B" & Rows.Count).End(xlUp).Row + 1
' Write values to Target Cells in First Empty Row.
Range("B" & FER).Value = TextBox1.Text
Range("C" & FER).Value = TextBox2.Text
Range("D" & FER).Value = ("OUT")
' Clear the Text boxes.
TextBox1 = ""
TextBox2 = ""
Exit For ' Stop looping.
End If
Next
End Sub
Remarks
How would this make any sense?
What if OP didn't tell us that xCell.Select triggers a Selection Change event which will write values to xCell and the text boxes and will restrict this to the used range of column A?
I'm newer to vba and need assistance. Currently, I have a drop-down list in a specific column (E1:E519) where staff can choose a check mark or leave it blank. However, if someone has 400 people or so to check boxes for, this can be annoying. So this prompted me to create a command button on the side using vba to select and deselect all in that specific column range.
How do I create a vba code that only allows checks to fill in the blanks in a selected range in cells that have a drop down list option (there is only 1 option in the drop down list, which is a check mark). The drop down list must remain for users who prefer to check each box individually and not use a command button. Column E either gets a check or is left blank. It'd be much easier if it recognized that if column B has data, then a check mark should be added to column E in the same row. If there is a code for that I would sure appreciate all the help I can get. The exact check mark I use is Arial Unicode MS font with a subset Dingbat character code 2713.
Can someone please help me and show me how to do it properly? I would also appreciate a bit of an explanation so that I can understand the code language and further learn. Thank you!
Current Code I'm Using (shows "?" instead of a check that is located in cell E14 (row 14, column 5) which is a check mark):
Private Sub CommandButton1_Click()
Dim c As Range
Dim check As Long
check = 0 'Define 0 for crossmark or 1 for checkmark
For Each c In Range("E17:E519") 'Define your range which should look value not equal to 1, then loop through that range.
If c <> 1 Then 'check if value in range is not equal to 1
With c 'Define what you want to do with variable c
If check = 1 Then 'If check = 1, then
.Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
.Font.Size = 12 'Font size
.FormulaR1C1 = "ü" 'special character for checkmark
ElseIf check = 0 Then 'If cehck = 1, then
.Font.Name = "Arial Unicode MS" 'Apply font "Arial Unicode MS"
.Font.Size = 12 'Font size
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.FormulaR1C1 = "?"
End If
End With
End If
Next c
End Sub
Next code
Sub change_cells_ref2()
Dim ws As Worksheet
Dim c As Range
Dim c_row_number As Long
Dim rangeinput As Variant
Set ws = Worksheets("NFLES ILT Form") 'Define the worksheet the code should be applied to
Application.ScreenUpdating = False 'Turn off screen update, makes the calculations more smooth and faster.
Set rangeinput = Range("E17:E519") 'Set Range where you want to check if the variable c is empty. If you have headers, set "B2:B519"
For Each c In rangeinput 'This line defines your range where you are looking for "", then loop through that range.
c_row_number = c.Row 'Gives us the current row number for the loop variable c which we are looping.
If c <> "" Then 'Checks if the value in variable c is empty
ws.Cells(14, "E").Copy 'Copy from cell(14,5) where cells(row number, column number). This will copy row 14, column 5, which is cell E14
ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
End If 'End the if statement where we check which value variable c has.
Next c 'Go to next c in the range
Application.CutCopyMode = False 'Cancel any copy selection
Application.ScreenUpdating = True 'Turn off screen update
End Sub
The tricky part here is what kind of character you have used for crossmark/ticker. So I list two approaches, which the first one I have used earlier.
As I want it to be standardized in both macro and dropdown list I choose a character set in the cells B1 and B2 as dummy variables.
B1 = checkmarks (✓) = 1 and B2 = crossmarks (✗) = 0. The great benefit is that I can use the same characters in my drop down-list (see picture) and the VBA code. Notice that both my cells, B1 and B2 has drop-down lists. When my code copy these cells, the drop-down list will follow to the new cells.
When I run the code I first need to choose 1 or 0. What you choose depends if the code will copy checkmarks (which is value 1) or crossmarks (value 0).
Next window is where you define your range. You can either write it like: E20:E50 or you can select it by selecting with your mouse.
Then the code processes and the result will be changed cells:
VBA Code:
Sub change_cells_ref()
Dim c As Range
Dim check_or_cross As Variant
Dim c_row_number As Long
Dim rangeinput As Variant
check_or_cross = Application.InputBox("Enter ""1"" for checkmark or ""0"" for crossmark") 'Input box for checkmarks (enter: 1) or crossmarks (enter: 0)
On Error Resume Next 'If error occurs, this is not a good way to mask errors... but if you press cancel in the inputbox when you are setting a range, VBA automatically throws an error: 13 before we can catch it, so we mask any errors that can occurs.
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8) ' Input box for Range, Type:=8 tells us that the value has to be in range format. You could either select or write range.
For Each c In rangeinput 'Range("E17:E150") - remove "rangeinput" to have a static range. This line defines your range where you are look for "zxyx", then loop through that range.
c_row_number = c.Row 'Gives us the current row for the loop variable c which we are looping.
If c <> "zxyz" Then 'Checks if the value is combination that is very unlikely to occur. It will overwrite all those values that are not "zxyz".
'If you replace the above code line with [If c = "" Then] the code would only overwrite cells that has not checkmark or crossmark...i,e only empty cells, could be good if you have some workers who answered, and some that hasn't. And only want to fill in those who didn't answer quickly.
With c 'Define what you want to do with the variable c
If check_or_cross = 1 Then 'If the user wrote 1, then copy checkmarks
.Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
.Font.Size = 12 'Set the Font size
Cells(1, 2).Copy 'Copy from cell(1,2) where cells(row number, column number). This will copy row 1, column 2, which is cell B1
Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
ElseIf check_or_cross = 0 Then 'If the user wrote 0, then copy crossmarks
.Font.Name = "Times New Roman" 'Set font that you want to use, remember all fonts doesn't support special characters/crossmark/checkmarks
.Font.Size = 12 'Set the Font size
Cells(2, 2).Copy 'Copy from cell(2,2) where cells(row number, column number). This will copy row 2, column 2, which is cell B2
Cells(c_row_number, 5).PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
End If 'End the if statement (if check_or_cross is 1 or 0)
End With 'Close the With c part
End If 'End the if statement where we check which value c has.
Next c 'Go to next c in the range
On Error GoTo 0
End Sub
If you always want a static range and skip the input box for the range part, you could remove these 3 lines:
On Error Resume Next
Set rangeinput = Application.InputBox(prompt:="Select range or Enter range, i.e. E17:E150", Type:=8)
'...code....
On Error GoTo 0
And then replace this part
For Each c In rangeinput -> For Each c In Range("E17:E517") - where E17:E517 is your range that you want to change the check/crossmarks
Alternative approach:
This code uses the font size "Wingding".
The disadvantage here is that you are not able to use this style in a "good" way in drop-down list. You will have values "ü" = ✓ and for û = ✗. That means in the drop-down list you will have u's, but in macro it will show correct values when the result is presented.
Advantage is that you don't need any dummy cells, as code will not copy any cells. It writes the values directly from the code. If you have case where you only want to use macro and no drop-down list, this could be a perfect approach.
Sub change_cells()
Dim c As Range
Dim check As Long
check = 0 'Define 0 for crossmark or 1 for checkmark
For Each c In Range("E17:E150") 'Define your range which should look value not equal to 1, then loop through that range.
If c <> 1 Then 'check if value in range is not equal to 1
With c 'Define what you want to do with variable c
If check = 1 Then 'If cehck = 1, then
.Font.Name = "Wingdings" 'Apply font "Wingdings"
.Font.Size = 12 'Font size
.FormulaR1C1 = "ü" 'special character for checkmark
ElseIf check = 0 Then 'If cehck = 1, then
.Font.Name = "Wingdings" 'Apply font "Wingdings"
.Font.Size = 12 'Font size
.FormulaR1C1 = " û " 'special character for crossmark
End If
End With
End If
Next c
End Sub
Another light approach is shown in the result below:
The code will look if the cell in column B is not empty. If cell is not empty (formulas that returns: "" are treated as empty) it will copy the value from dummy cell A1 and paste in the column E in the same row.
Notice to setup a dummy cell with data-validation and the checkmark ✓. The reason is that the character 2713 is a special character and in VBA it would have result in "?" character. Therefore we copy it in the excel environment where it can be treated correctly including the drop-down list
Variables to in the code set:
Worksheet name, pre-defined as: "Sheet1"
Range where to look for data: "B1:B519"
ws.Cells(1, "A").Copy - cell where dummy variable is located ("A1").
ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll - Set column where checkmark should be pasted to.
VBA Code:
Sub change_cells_ref2()
Dim ws As Worksheet
Dim c As Range
Dim c_row_number As Long
Dim rangeinput As Variant
Set ws = Worksheets("Sheet1") 'Define the worksheet the code should be applied to
Application.ScreenUpdating = False 'Turn off screen update, makes the calculations more smooth and faster.
Set rangeinput = Range("B1:B519") 'Set Range where you want to check if the variable c is empty. If you have headers, set "B2:B519"
For Each c In rangeinput 'This line defines your range where you are looking for "", then loop through that range.
c_row_number = c.Row 'Gives us the current row number for the loop variable c which we are looping.
If c <> "" Then 'Checks if the value in variable c is empty
ws.Cells(1, "A").Copy 'Copy from cell(1,1) where cells(row number, column number). This will copy row 1, column 1, which is cell A1
ws.Cells(c_row_number, "E").PasteSpecial xlPasteAll 'Paste into current row in loop and column 5 (column E)
End If 'End the if statement where we check which value variable c has.
Next c 'Go to next c in the range
Application.CutCopyMode = False 'Cancel any copy selection
Application.ScreenUpdating = True 'Turn off screen update
End Sub
I'm hoping to find a way to copy a cell value down Column B until the first blank cell in Column E. What I have is basically this:
But what I would like to have happen automatically is this:
Is there a way to make the product name copy down Column B automatically whenever a new ingredient is added in Column E, and then start over with a new product name when a new product is added (after a blank row).
If you want to add ingredients to column E manually, you can use a formula in C.
In cell C3 put this formula and drag down as far as needed:
=IF(AND(E2<>"",E3<>""),"Product "&COUNTBLANK($E2:$E$3)+1,IF(AND($E2="",ISBLANK($E2),$E3<>""),"Product "&COUNTBLANK($E$2:$E2),""))
You should be able to use the Worksheet.Change event to do this. This code goes in the sheet module. It may need tweaked but basically does the following:
When cell(s) in the worksheet change, checks if the cell is in Column E. I assume that you'd be entering ingredients one at a time, so the For each rng... might be overkill.
Checks if the cell is not the first ingredient in a new product list. The easiest way I thought of doing that was checking if the cell above it is not blank, and that the cell one row above and three columns to the left (i.e. where the product name is populated) is not blank as well.
If the previous two conditions are met, "copies" the Product name down a row.
So each new product name must be entered manually, skipping a line after the previous product, and the filling down will happen with the 2nd ingredient on.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo ErrHandler
Application.EnableEvents = False
For Each rng In Target
If Not Intersect(rng, Columns(5)) Is Nothing Then
If rng.Row > 1 And Not IsEmpty(rng.Offset(-1)) And Not IsEmpty(rng.Offset(-1, -3)) Then
rng.Offset(, -3).Value = rng.Offset(-1, -3).Value
End If
End If
Next rng
ErrHandler:
Application.EnableEvents = True
End Sub
This is not inherently "Automatic" but each time it's run it will fill in your product names.
Sub Test()
Dim oPrevName As String
oPrevName = ""
For icounter = 1 To Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
If Sheet1.Cells(icounter, 5).Value <> "" Then
If Sheet1.Cells(icounter, 2).Value <> oPrevName And Sheet1.Cells(icounter, 2).Value <> "" Then
oPrevName = Sheet1.Cells(icounter, 2).Value
End If
Sheet1.Cells(icounter, 2).Value = oPrevName
End If
Next
End Sub
We store the previous non-blank name found in the product column (2). If there is an ingredient listed on the same row (in Column 5), we add the stored product name.
So, I have three very large columns of data. I want these to match, but there are lots of mismatching rows between the columns.
What I want to do is write a looping macro to delete the contents in cell F2 if they are not equal to the contents in either A2 or K2. However, I can only find details on writing looping macros for ranges. Is it possible to have a command carried out on the same cell over and over? So far I have:
Sub ArrayMatch()
Application.ScreenUpdating = True
Dim F As Range
For Each F In Range("F2:F2043").Cells
F.Select
If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0], [5]) Then
Selection.Delete Shift:=xlUp
Else: Stop
End If
Next
At the moment, I just want the code to stop if any of these are equal. However, the way I have the range defined here, the code is only applied to every other cell in the range. Can I rephrase this range to have the rest of the code applied to cell F2 over and over again?
Thanks! I'll keep experimenting with what I have while eagerly awaiting a response!
Assuming your input:
Can I rephrase this range to have the rest of the code applied to cell
F2 over and over again?
that's NOT exactly what you expect. The clue is you should check every cell in range, and move to the NEXT only in case it does NOT meet the criteria. Otherwise the row is deleted, and you should stay on the same spot, i.e. DON'T move down, since if A1 is removed, A2 now becomes A1, and you should check it again.
The below code will do the job (perhaps you should modify the criteria, but the idea is that):
Sub RemoveRows()
Dim i As Long
Dim ActiveCell As Range
i = 2
Do While i <= 2043
Set ActiveCell = Range("F" & i)
If ActiveCell <> ActiveCell.Offset([0], [-5]) And ActiveCell <> ActiveCell.Offset([0], [5]) Then
Selection.Delete Shift:=xlUp
Else
i = i + 1
End If
Loop
End Sub
This is the sample for quite similar task: https://www.dropbox.com/s/yp2cwphhhdn3l98/RemoweRows210.xlsm
Try using something like this:
Sub checkF()
RowCount = WorksheetFunction.CountA(Range("F2").EntireColumn)
While RowCount >= 1
If Range("F2").Value = Range("A2").Value Or Range("F2").Value = Range("K2").Value Then
Stop
Else
Range("F2").Delete Shift:=xlUp
End If
RowCount = RowCount - 1
Wend
End Sub
This will loop through the until there is 1 value left in column F and will stop when any of the values match.
Here is a simple loop that will do the following:
Retrieve all cell values for row 2 of columns A, F and K
Check if the value in F2 equals A2 or K2
If equal, do nothing and exit macro
If not equal, delete the value in F2, shift the cells up, retrieve new F2 value, then start over from step 1
Here's the code:
Public Sub MatchFirstRow()
Dim fCellValue As String
Dim aCellValue As String
Dim kCellValue As String
Dim shouldCheckAgain As Boolean
'get values of each cell in question
fCellValue = Cells(2, 6).Value
aCellValue = Cells(2, 1).Value
kCellValue = Cells(2, 11).Value
shouldCheckAgain = True
'loop through while the cell in "F" has a value AND the previous value wasn't a match
While Not IsEmpty(fCellValue) And Not fCellValue = "" And shouldCheckAgain
shouldCheckAgain = False
'If row values don't match, delete cell in F, shift up, then
'reinitialize the F cell value for next pass
If Not StrComp(fCellValue, aCellValue, vbTextCompare) _
And Not StrComp(fCellValue, kCellValue, vbTextCompare) Then
Cells(2, 6).Select
Selection.Delete Shift:=xlUp
fCellValue = Cells(2, 6).Value
shouldCheckAgain = True
End If
Wend
End Sub
Simply paste this code into the VB Editor for the sheet that contains the columns in question. For example, if Sheet1 has the columns, then open the Visual Basic Editor, double click Sheet1, then paste the code there.
Once the code is pasted you can run this as a regular macro by choosing the Macros button.
You should do this without loops, either with
Inserting a working column that uses an =OR(F2=K2,F2=A2) to return True or False results, then use AutoFilter either manually or with vba to delete the False results
Get funky and do (1) directly in a variant array like below, then dump the variant array back over the original range
code
Sub GetEm()
X = Filter(Application.Transpose(Application.Evaluate("=IF(--(F2:F2043=A2:A2043)+--(F2:F2043=K2:K2043),F2:F2043,""x"")")), "x", False)
Range("F2:F2043").Value = vbNullString
[f2].Resize(UBound(X), 1).Value = Application.Transpose(X)
End Sub
The Worksheet_Change sub of the sheet should work here. That sub gets called whenever a cell in that sheet changes.
'This sub placed in one of the "Sheet1"/"Sheet2"/... objects in the list of
'Microsoft Excel Object in the VBA Editor will be called everytime you change
'a cell value in the corresponding sheet.
'"Target" is the effected cell.
Private Sub Worksheet_Change(ByVal Target As Range)
'Check that Target is cell F2 (6th column, 2nd row)
If Target.Row = 2 And Target.Column = 6 Then
'If this is the cell we are looking for call the sub ValidateF2
ValidateF2
End If
End Sub
And:
Sub ValidateF2()
'Check that the value of F2 is not equal to A2 or K2
If Not (Range("F2").Value = Range("A2").Value Or Range("K2").Value = Range("K2").Value) Then
'Set the value of F2 to "" (empty)
Range("F2").Value = ""
End If
End Sub