Workbook Structure
Worksheet1 (Sheet1)
Worksheet2 (References)
Form (Initials_Comment_Box)
Module1 (FindNA)
Form Image
Purpose
To create a pop-up form every time the user enters N/A into Sheet1 and save what the user wrote into the same coordinates (the N/A was located in) on Worksheet2(References). The user using the form can change the coordinates in the form textbox2.
E.g. When a user types in Sheet1 they type N/A and then execute the cell in one of the following ways:
To solve this problem I added to the User form Textbox2, so the coordinates can appear here and the user can then change them. Then when the OK button is clicked on the user form more code can check if there is an "N/A" in the textbox2 cell.
If N/A is not in the coordinates specified by the user, the user must change the coordinates. But if N/A is in those coordinates specified by the user - the code is executed and the comment from Textbox1 is saved in the same coordinates the N/A was executed in, but on Worksheet2.
My questions:
Is there a better way to do this? If so how? and If not, where does my code need a tweak? Thank you.
Worksheet1(Sheet1) Code
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Dim rInt As Range
Dim k As Range
Dim Substitute As Range
'Range of where popup can occur
Set rInt = Intersect(Target, Range("A15:AD999"))
On Error Resume Next
'Allows cells to be removed
If Target.Cells.CountLarge > 1 Then Exit Sub
'If cell contains "N/A' Then popup occurs
If rInt Is Nothing Or Target.Cells = "N/A" Then
Application.EnableEvents = False
'Run form Initials_Comment_Box
Initials_Comment_Box.Show
'Run module 'FindNA'
Application.Run "'InitialsAndCommentBox-Logger-6.xlsm'!TextChanged"
'Application.Run (TextBox1_TextChanged)
'Run module to initialise forms, put k from findna into textbox
Initials_Comment_Box.TextBox1.Text = ActiveCell
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("A15:AD999")) Is Nothing Then
End If
On Error Resume Next
End Sub
Form (Initials_Comment_Box)
Option Explicit
Private Sub OK_Click()
Dim ws As Worksheet, ws1 As Worksheet
Set ws = Worksheets("References")
Set ws1 = Worksheets("Sheet1")
ws1.Unprotect
On Error Resume Next
'Checks for a comment.
If Trim(Me.TextBox.Value) = "" Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
'Checks Comment text box ('TextBox') if the comment is atleast 2 characters long
If Trim(Me.TextBox.TextLength) < 2 Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
'Checks the coordinates text box ('TextBox1') if the comment is atleast 2 characters long
If Trim(Me.TextBox1.TextLength) < 2 Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
Initials_Comment_Box.Hide
'ws1.Protect
End Sub
'Forces user to enter something
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please enter your initials and a breif comment."
End If
End Sub
FindNA
'When the N/A cell is executed (Enter, Tab, arrow key or clicked) then the active cell is adjacent to the N/A value.
'This searches for the N/A value in the order of, above, left of, below or right of the active cell.
Sub FindNA(FinNA As String)
Dim k As Range
'Locate closest N/A
If ActiveCell.Offset(-1, 0).Value = "N/A" Then
Set k = ActiveCell.Offset(-1, 0)
ElseIf ActiveCell.Offset(0, -1).Value = "N/A" Then
Set k = ActiveCell.Offset(0, -1)
ElseIf ActiveCell.Offset(0, 1).Value = "N/A" Then
Set k = ActiveCell.Offset(0, 1)
ElseIf ActiveCell.Offset(1, 0).Value = "N/A" Then
Set k = ActiveCell.Offset(1, 0)
Else: Set k = ActiveCell
End If
MsgBox (k)
'Put k value into textbox1
Initials_Comment_Box.TextBox1.Text = k
End Sub
Worksheet1 (Sheet1)
Worksheet2 (References)
Form (Initials_Comment_Box)
Module1 (FindNA)
Form Image
Purpose
To create a pop-up form every time the user enters N/A into Sheet1 and save what the user wrote into the same coordinates (the N/A was located in) on Worksheet2(References). The user using the form can change the coordinates in the form textbox2.
E.g. When a user types in Sheet1 they type N/A and then execute the cell in one of the following ways:
- Click
- Press an arrow key
- Press Enter
- Press Tab
- Click - Anywhere on the worksheet
- Press an arrow key - up, down, left, right
- Press Enter - down
- Press Tab - right
To solve this problem I added to the User form Textbox2, so the coordinates can appear here and the user can then change them. Then when the OK button is clicked on the user form more code can check if there is an "N/A" in the textbox2 cell.
If N/A is not in the coordinates specified by the user, the user must change the coordinates. But if N/A is in those coordinates specified by the user - the code is executed and the comment from Textbox1 is saved in the same coordinates the N/A was executed in, but on Worksheet2.
My questions:
Is there a better way to do this? If so how? and If not, where does my code need a tweak? Thank you.
Worksheet1(Sheet1) Code
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Dim rInt As Range
Dim k As Range
Dim Substitute As Range
'Range of where popup can occur
Set rInt = Intersect(Target, Range("A15:AD999"))
On Error Resume Next
'Allows cells to be removed
If Target.Cells.CountLarge > 1 Then Exit Sub
'If cell contains "N/A' Then popup occurs
If rInt Is Nothing Or Target.Cells = "N/A" Then
Application.EnableEvents = False
'Run form Initials_Comment_Box
Initials_Comment_Box.Show
'Run module 'FindNA'
Application.Run "'InitialsAndCommentBox-Logger-6.xlsm'!TextChanged"
'Application.Run (TextBox1_TextChanged)
'Run module to initialise forms, put k from findna into textbox
Initials_Comment_Box.TextBox1.Text = ActiveCell
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("A15:AD999")) Is Nothing Then
End If
On Error Resume Next
End Sub
Form (Initials_Comment_Box)
Option Explicit
Private Sub OK_Click()
Dim ws As Worksheet, ws1 As Worksheet
Set ws = Worksheets("References")
Set ws1 = Worksheets("Sheet1")
ws1.Unprotect
On Error Resume Next
'Checks for a comment.
If Trim(Me.TextBox.Value) = "" Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
'Checks Comment text box ('TextBox') if the comment is atleast 2 characters long
If Trim(Me.TextBox.TextLength) < 2 Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
'Checks the coordinates text box ('TextBox1') if the comment is atleast 2 characters long
If Trim(Me.TextBox1.TextLength) < 2 Then
Me.TextBox.SetFocus
MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
Exit Sub
End If
Initials_Comment_Box.Hide
'ws1.Protect
End Sub
'Forces user to enter something
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please enter your initials and a breif comment."
End If
End Sub
FindNA
'When the N/A cell is executed (Enter, Tab, arrow key or clicked) then the active cell is adjacent to the N/A value.
'This searches for the N/A value in the order of, above, left of, below or right of the active cell.
Sub FindNA(FinNA As String)
Dim k As Range
'Locate closest N/A
If ActiveCell.Offset(-1, 0).Value = "N/A" Then
Set k = ActiveCell.Offset(-1, 0)
ElseIf ActiveCell.Offset(0, -1).Value = "N/A" Then
Set k = ActiveCell.Offset(0, -1)
ElseIf ActiveCell.Offset(0, 1).Value = "N/A" Then
Set k = ActiveCell.Offset(0, 1)
ElseIf ActiveCell.Offset(1, 0).Value = "N/A" Then
Set k = ActiveCell.Offset(1, 0)
Else: Set k = ActiveCell
End If
MsgBox (k)
'Put k value into textbox1
Initials_Comment_Box.TextBox1.Text = k
End Sub