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

atrels

New Member
Joined
Aug 2, 2020
Messages
12
Office Version
  1. 365
Platform
  1. Windows
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
 
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

Rich (BB code):
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.
VBA Code:
With Initials_Comment_Box
    .TextBox2.Text = Target.Address
    .Show
End With

That is fantastic, I appreciate all of your help immensely. I have made your suggested changes and it is better again. Thank you.

VBA Code:
Option Explicit
Private Sub OK_Click()
Dim ws As Worksheet, ws1 As Worksheet
Set ws = Worksheets("References")
Set ws1 = Worksheets("Sheet1")

ws1.Unprotect

'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

ws.Range(Me.TextBox1.Value) = Me.TextBox.Value & " | " & " Name: " & Application.UserName & " | PC: " & Environ("username") & " | Date & Time: " & Now

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
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Forum statistics

Threads
1,214,522
Messages
6,120,020
Members
448,939
Latest member
Leon Leenders

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