Excel VBA user form - How can I save information on another sheet?

[atrels]

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:

• Click
• Press an arrow key
• Press Enter
• Press Tab

This leaves the active cell to be:

• Click - Anywhere on the worksheet
• Press an arrow key - up, down, left, right
• Press Enter - down
• Press Tab - right

To execute a cell, and my code in Module1(FindNA) is able to find up, down, left or right but not anywhere on the worksheet (a click).

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

 

[mikerickson]

You want the userform to show when the user enters N/A in a cell.
From the code, it looks like you want this to be restricted to cells in A15:AD999. Your existing code also tests if Target is only one cell, which would make this unresponsive to N/A that comes from a multi-cell paste.

The Worksheet_Change event fires after any value in the worksheet is changed. It does not fire when the user is typing their entry only after cell value is changed, so the concern about pressing Enter vs. Tab vs arrow key is unneeded.

In the Change event, Target is the range of cells that have been changed. So casting about to find the cell in which the user entered N/A is unneeded. That cell will be Target. Your FindNA is searching around the ActiveCell, which is different than Target. and is completely unneeded, We know that Target is the cell that contains N/A.

The change event that would invoke the userform might look like this (in the code module for Sheet1)

Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt As Range
    Dim k As Range
    Dim Substitute As Range
    With Target
        If .Cells.Count = 1 and Not(Application.Intersect(.Cells, Range("A15:AD999")) Is Nothing) Then
            If  .Value = "N/A" Then
                ' invoke UserForm
            End If
        End If
    End With
End Sub

 

[atrels]

You want the userform to show when the user enters N/A in a cell.
From the code, it looks like you want this to be restricted to cells in A15:AD999. Your existing code also tests if Target is only one cell, which would make this unresponsive to N/A that comes from a multi-cell paste.

The Worksheet_Change event fires after any value in the worksheet is changed. It does not fire when the user is typing their entry only after cell value is changed, so the concern about pressing Enter vs. Tab vs arrow key is unneeded.

In the Change event, Target is the range of cells that have been changed. So casting about to find the cell in which the user entered N/A is unneeded. That cell will be Target. Your FindNA is searching around the ActiveCell, which is different than Target. and is completely unneeded, We know that Target is the cell that contains N/A.

The change event that would invoke the userform might look like this (in the code module for Sheet1)

Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt As Range
    Dim k As Range
    Dim Substitute As Range
    With Target
        If .Cells.Count = 1 and Not(Application.Intersect(.Cells, Range("A15:AD999") Then
            If  Target.Value = "N/A" Then
                ' invoke UserForm
            End If
        End If
    End With
End Sub

Wow that is amazing, thank you I appreciate your help in solving my problem.

I will let you know how I go.

 

[mikerickson]

I just looked back at what I posted and the Application.Intersect bit was missing quite a bit of code so I edited.

 

[atrels]

I just looked back at what I posted and the Application.Intersect bit was missing quite a bit of code so I edited.

Thank you Mike Rickson.

 

[atrels]

Hi mikerickson,

This seems works perfectly, this is how I have edited it.

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt As Range
    Dim k As Range
    Dim Substitute As Range
    Dim C As String
    Dim R As String
    
    With Target
        If .Cells.Count = 1 And Not (Application.Intersect(.Cells, Range("A15:AD999")) Is Nothing) Then
            If .Value = "N/A" Then
                Application.EnableEvents = False
                Initials_Comment_Box.TextBox1 = Target.Address
                Initials_Comment_Box.Show
                Application.EnableEvents = True
            End If
        End If
    End With
End Sub

How do I then pass the Target.Address from the sheet so when the user presses 'Ok' the information is saved at the same cell coordinates?

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

With ws
    Me.TextBox1.Value = Me.TextBox.Value
End With


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

 

[atrels]

Hi mikerickson,

This seems works perfectly, this is how I have edited it.

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt As Range
    Dim k As Range
    Dim Substitute As Range
    Dim C As String
    Dim R As String
   
    With Target
        If .Cells.Count = 1 And Not (Application.Intersect(.Cells, Range("A15:AD999")) Is Nothing) Then
            If .Value = "N/A" Then
                Application.EnableEvents = False
                Initials_Comment_Box.TextBox1 = Target.Address
                Initials_Comment_Box.Show
                Application.EnableEvents = True
            End If
        End If
    End With
End Sub

How do I then pass the Target.Address from the sheet so when the user presses 'Ok' the information is saved at the same cell coordinates?

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

'This is the part that isn't working for me#######################
With ws
    Range(Me.TextBox1.Value) = Me.TextBox.Value
End With


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

 

[atrels]

Apologies, ignore my last message.

I am just pointing out, that I am struggling to get the textbox value (Me.TextBox.Value) into the reference sheet (ws)

With ws
    Range(Me.TextBox1.Value) = Me.TextBox.Value
End With

 

[atrels]

I was able to change the above code to:

ws.Range(Me.TextBox1.Value) = Me.TextBox.Value

And it works. Mike Rickson/Anyone Is there any modifications to my second chuck of code that could be improved?

Thank you.

 

[mikerickson]

I notice there is no 1 in the line If Trim(Me.TextBox.Value) Then and several others.
And that you have the On Error Resume Next masking any errors.
I would remove the On Error (so Excel can tell you when it goes wrong)
And check the names of the textbox, I suspect it is actualy TextBox1

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: Rem delete

'Checks for a comment.
If Trim(Me.TextBox1.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.TextBox1.TextLength) < 2 Then
  Me.TextBox1.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.TextBox1.SetFocus
  MsgBox "Please enter your initials, a breif comment and the coordinates of N/A."
  Exit Sub
End If

With ws
    Me.TextBox1.Value = Me.TextBox.Value
End With


Initials_Comment_Box.Hide


'ws1.Protect
End Sub

As for passing the Target.Address to the userform. it looks like one requirment is that the uf have a textbox, TextBox2, for "the user using the form can change the coordinates address in the form textbox2."
So passing Target.Address to the userform can be done at the time the Userform is invoked.

With Initials_Comment_Box
    .TextBox2.Text = Target.Address
    .Show
End With