Got a workbook with two sheets in it. The first is where the data is, and the second has been set up as a "corrections" page. This workbook is sent out to users who are to review it and note inconsistencies/discrepencies. Right now it's set up to highlight the cell via double-click then forward the active cell to a cell at the end of the same row. As it turns out people want more room for comments so I've decided to go with a second sheet that works as a comments sheet. I've got the userform and everything with it done except the "submit" button. When the user double-clicks now the cell is still highlighted, but instead of forwarding to the end of row it opens the user form for comments. I'm trying to get the submit button to do two things:
First, I want it to place the row# of the cell that was highlighted into the first column; and second, I want what the user puts in the textbook to be placed into the second column.
I can get it to enter a value in the first row for the textbox, but I don't know where to start for the row#'s (maybe ActiveCell.Row ?); also, I don't know how to go about getting it set to move down to the next row if the first row already has comments in it (need something with a Row +1 I guess? It's just this one last button that's slowing me up; got the rest done, but I could use some advice on this part of the userform coding. Thanks!
Here's how I'd do it (rough draft):
Private Sub Worksheet_Beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
Const CLR_INDX As Integer = 6
If Target.Interior.ColorIndex = xlNone Then 'If cell is clear
With frmCorrections
Set .CellRange = Target
.HiliteColorIndex = CLR_INDX
.Show
End With
'Or Else if cell is already yellow
ElseIf Target.Interior.ColorIndex = CLR_INDX Then
Target.Interior.ColorIndex = xlNone 'Then clear the background
End If
Cancel = True
End Sub
and the user form code:
Dim m_rng As Range
Dim m_index As Integer
Public Property Set CellRange(rng As Range)
Set m_rng = rng
End Property
Public Property Let HiliteColorIndex(indx As Integer)
m_index = indx
End Property
Private Sub cmdCancel_Click()
Me.Hide
End Sub
Private Sub cmdOK_Click()
Dim cmt As String, NextCell As Range
cmt = Me.txtComment.Text
If Len(cmt) > 0 Then
Set NextCell = ThisWorkbook.Sheets("Corrections").Cells( _
Rows.Count, 1).End(xlUp).Offset(1, 0)
With NextCell
.Parent.Hyperlinks.Add Anchor:=NextCell, Address:="", _
SubAddress:=m_rng.Address(False, False, , True), _
TextToDisplay:=m_rng.Address(False, False)
.Offset(0, 1).Value = cmt
End With
m_rng.Interior.ColorIndex = m_index
End If
Me.Hide
End Sub
Private Sub UserForm_Activate()
Me.txtComment.Text = ""
Me.lblHeader.Caption = "Enter comment for cell: " & _
m_rng.Address(False, False)
End Sub
EDIT:
This is what I finally came up with to get it working the way I wanted. On the first worksheet the user can double click on the cell, which then highlights the cell and prompts with the user form. If the user cancels then the highlight is removed and the user can keep working; if they enter anything in the box and submit it then the cell addressis placed in one row on the "Comments" page and the text is enteredone column over in the row corresponding to the original cell's address so I can see where the correction is and what their justification was. Anyways the codes are below.
I use the following for highlighting and calling the form:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
Dim TargRow As Variant
Dim TargCol As Variant
TargRow = Target.Row
TargCol = Target.Column
Header = 8
FirstCol = 0
LastCol = 13
CommentCol = 13
If TargRow > Header And TargCol > FirstCol And TargCol < LastCol Then
'If the cell is clear
If Target.Interior.ColorIndex = xlNone Then
Cancel = True
'Then change the background to yellow
Target.Interior.ColorIndex = 6
Corrections.Show
'Else if the cell background color is already yellow
ElseIf Target.Interior.ColorIndex = 6 Then
'Then clear the background
Target.Interior.ColorIndex = xlNone
End If
End If
'This is to prevent the cell from being edited when double-clicked
Cancel = True
Application.EnableEvents = True
End Sub
And I use this for the user form itself:
Private Sub UserForm_Initialize()
TextBox.Value = ""
End Sub
Private Sub CommandButton2_Click()
Unload Corrections
ActiveCell.Interior.ColorIndex = xlNone
End Sub
Private Sub CommandButton1_Click()
Dim PrevCell As Range
Set PrevCell = ActiveCell
ActiveWorkbook.Sheets("Comments").Activate
Range("A6").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = PrevCell.Address
ActiveCell.Offset(0, 1) = TextBox.Value
Unload Corrections
ActiveWorkbook.Sheets("DataPage").Activate
End Sub
Related
I make an Excel file that I use to import on a website. However, the values displayed mean nothing to the website, it needs IDs, but it's just not user-friendly. To help my users I said to myself I'll make a drop-down list that will change the value. For example, if you click on Switzerland, it will show 1 in the cell.
I have created one Macro based on the instruction on https://www.extendoffice.com/documents/excel/4130-excel-drop-down-list-show-different-value.html
'Updateby Extendoffice
Dim xRg As Range
selectedNa = Target.Value
If Target.Column = 3 Then
Set xRg = ActiveWorkbook.Names("Dropdown_cantons").RefersToRange
selectedNum = Application.VLookup(selectedNa, xRg, 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
End If
End If
End Sub
For the first column it's ok
For my second collone with the cities this time, I thought I would change the collone numbers and follow the instructions in the link above. Maybe I can't put two macros in one Excel?
I tried to do it as a module, but it doesn't work for the second collone either. Do you have an idea?
Could look something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'only handle single-cell changes
Select Case Target.Column
'depending on the column number, call `SetId` with specific arguments
Case 3: SetId Target, ActiveWorkbook.Names("Dropdown_cantons").RefersToRange, 2
Case 4: SetId Target, ActiveWorkbook.Names("Dropdown_countries").RefersToRange, 2
End Select
End Sub
'translate a data validation drop-down "text" selection into a matching "id" value
Sub SetId(c As Range, rngTable As Range, returnCol As Long)
Dim v, res
v = c.Value
If Len(v) > 0 Then
res = Application.VLookup(v, rngTable, returnCol, False) 'find the id
If Not IsError(res) Then 'got a match
On Error GoTo haveError 'ensure we exit with events back on
Application.EnableEvents = False 'disable events
c.Value = res 'switch the value
Application.EnableEvents = True 're-enable events
End If
End If
Exit Sub 'normal exit
haveError:
Application.EnableEvents = True 'just in case....
End Sub
I need to ensure that the user types in an integer with length (blank) in any cell of a certain column. If the user inputs a number that is not length (blank), the Excel freezes the user at that cell and prompts to re-enter until integer length (blank) has been inputted or cancel is hit.
I currently have most of the things I request working. However, my issue is that Excel doesn't recognize length errors until I move away from the cell and come back to it.
For example (using 3 as desired length):
If i am currently on Cell B12 and type in 15646, which is not length 3, I can still click enter and it will move to Cell B13, which I want to prevent. But if I move up to B12 again from B13, the length error is seen and Excel prompts me to input integer with correct length until its fixed.
For now, the length error is only being recognized when I come back to cell. I need it to recognize as soon as I hit enter and prevent from moving on to next cell.
Sub InputNum()
row = ActiveCell.row
col = ActiveCell.Column
If col = 2 And ActiveCell.Value <> "" Then
Dim lotTextLen As Integer
lotTextLen = Len(ActiveCell.Value)
'checks to ensure the number put in is 3 characters long
'requests an input number to be put in
If lotTextLen <> 3 Then
lotData = InputBox("Invalid Entry Length. Scan in Lot #")
If Len(lotData) <> 3 Then
'error message
Result = MsgBox("Invalid Lot # Inputed. Must be 3 Characters. Try Again?", vbOKCancel)
'if cancel is clicked, input number is made blank and sub is exited
If Result <> vbOK Then
ActiveCell.Value = ""
'if ok is clicked to try again, recurses to beginning of code again
Else
InputNum
End If
Else
ActiveCell.Value = lotData
End If
End If
End If
End Sub
InputNum is being called in the Sheet1
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B:C")) Is Nothing Then
InputNum
End If
End Sub
In the sheet object place the following
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Columns(2)) Is Nothing Then
Application.EnableEvents = False
InputNum Target
Application.EnableEvents = True
End If
End Sub
Then use this in a standard module
Public Sub InputNum(Target As Range)
Dim IoTData As String
Dim Result As String
Dim isCancel As Boolean
Do While Len(Target.Value2) <> 3
IoTData = InputBox("Invalid Entry Length. Scan in Lot #")
If Len(IoTData) = 3 Then
Target.Value2 = IoTData
Else
If IoTData <> vbNullString Then
' error message
Result = MsgBox("Invalid Lot # Inputed. Must be 3 Characters. Try Again?", vbOKCancel)
If Result <> vbOK Then isCancel = True
Else
isCancel = True
End If
End If
If isCancel Then
Target.Value2 = vbNullString
Exit Do
End If
Loop
End Sub
By placing your code in a loop it will keep pestering the user for the right length until either they enter the right format or they press cancel in which instance the cell will be cleared of it's input.
You can also add And IsNumeric(IoTData) to your If statement to test that a number has been entered.
Replace
If Len(IoTData) = 3 Then
With
If Len(IoTData) = 3 And IsNumeric(IoTData) Then
Option Explicit
Dim add As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:C")) Is Nothing And Target.Count = 1 Then
If Len(Target.Value) <> 3 Then
MsgBox "Invalid entry in cell with address " & add
Application.EnableEvents = False
Target.Activate
'Enter more code
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B:C")) Is Nothing And Target.Count = 1 Then
add = Target.Address
End If
End Sub
So I have a table with conditional formatting already setup (attached).
The values are being highlighted in red when greater than +/-35mm for each constituent separately (dE, dN, dH).
what I'm looking for is to create a userform so the user don't have to navigate to manage rules, instead the threshold for each constituent can be changed directly from the userform.
attached is also a photo of what I need Needed
All help greatly appreciated.
conditional_formatting
not sure what you are asking for but my understanding is you want to click on that record and edit it on a user form and you have your spread sheet already formatted.Use this code to achieve that.
place this code behind your sheet in VBA editor(the one with the data to be manipulated)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'##################################################
'# Intercept a double click in the record area #
'# and open the edit form 36 #
'##################################################
If Target.Column > 65 Or Target.Row < 1 Then
Exit Sub
End If
Cancel = True
EditRecord
End Sub
and place this one on a module
Sub EditRecord()
Dim CurRow As Integer, CurCol As Integer, intCount1 As Long
Dim RecordEntry
Dim iRow As Long
CurRow = ActiveCell.Row
Range("A" & CurRow).Select
' check if empty row - if so call new record
With ActiveCell
If ActiveCell.Value = "" Then
' check empty rows and create new record goto_empty_row
UserForm1.Show
Exit Sub
End If
End With
' edit existing record - populate form
With UserForm1
.TextBox1.Value = ActiveCell.Offset(0, 0)
.TextBox2.Value = ActiveCell.Offset(0, 1)
.TextBox3.Value = ActiveCell.Offset(0, 2)
.Show
End With
End Sub
and then this on your user form
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") 'name of the Sheet
'copy the data to the spread sheet
ws.Cells(ActiveCell.Row, 1).Value = Me.TextBox1.Value
ws.Cells(ActiveCell.Row, 2).Value = Me.TextBox2.Value
ws.Cells(ActiveCell.Row, 3).Value = Me.TextBox3.Value
End Sub
I am creating a spreadsheet that a user will fill in specific cells with data/text.
the whole sheet will be locked to prevent one from changing things.
i want as the first cell B4 to always be unlocked and has data entered in, this then unlocks cell B5 for data entry. this will continue on for many more cells.
here is what i have done so far.....
Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Range("B4:F4")) = True Then
Range("B5").Locked = False
End If
End Sub
So... I made an attempt to help you.
Private Sub Worksheet_Change(ByVal target As Range)
Const inputrange As String = "B4:F4"
Const lockrange As String = "B5:F5"
Const lockedworksheet As String = "Tabelle2"
Set insect = Application.Intersect(target, Range(lockrange))
If Not (insect Is Nothing) Then Exit Sub
Worksheets(lockedworksheet).Unprotect
Range(inputrange).Locked = False
Range(lockrange).Locked = True
For Each cell In Range(inputrange)
If IsNumeric(cell.Value) And cell.Value <> 0 Then _
Cells(cell.Row + 1, cell.Column).Locked = False Else _
Cells(cell.Row + 1, cell.Column).Value = ""
Next cell
Worksheets(lockedworksheet).Protect
End Sub
If you need an explanation, just ask.
I am trying to implement a code, where if you click a certain cell; you go to the first empty cell in a certain column.
Now I have this code:
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B2")) Is Nothing Then
Columns("E").Find(vbNullString, Cells(Rows.Count, "E")).Select
End If
End If
But there is a problem with this code: I want it to start checking the first empty cell; starting at row 3. How do I do this?
Edit1:
I have made some adjustments to the code to fit my needs (for practice and aesthetics);
Dim lastCell As Range
Set lastCell = Range("E:E").Find(vbNullString, [E3], , , , xlNext)
lastCell.Interior.Color = RGB(100, 200, 100)
lastCell.Offset(0, -3) = "Last Cell -->"
lastCell.Offset(0, -3).Interior.Color = RGB(0, 110, 250)
lastCell.Offset(0, -3).Font.Color = vbWhite
If Not Intersect(Target, [B2]) Is Nothing Then
lastCell.Select
Side Note
The reason for Offset three columns to the right is because of the lay-out of the sheet :)
I clear the formatting of the cell and the text somewhere else if lastCell is changed. So if anyone is interested, let me know.
You can re-write your code like this, just by supplying SearchDirection argument.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("B2")) Is Nothing Then
Columns("E").Find(vbNullString, Cells(Rows.Count, "E") _
, , , , xlPrevious).Select
End If
End If
End Sub
Or you can try this one:
Edit1: For brettdj :)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Goto errhandler
Application.EnableEvents = False
If Target.Cells.Count = 1 Then
If Not Intersect(Target, [B2]) Is Nothing Then _
Range("E:E").Find(vbNullString, [E3], , , , xlNext).Select
End If
continue:
Application.EnableEvents = True
Exit Sub
errhandler:
MsgBox Err.Description
Resume continue
End Sub
Both code works the same way except if there are blank cells in between E3:E(x).
Your revise code finds the first empty cell in Column E with reference to the last non empty cell.
The next code literally finds the first empty cell from E3. Don't know which is really what you need.
Side Notes:
Columns("E") is the same as Range("E:E").
Why use Range("E:E") then? Well, Intellisense kicks in with Range and not with Columns.
So I prefer using Range so you can see all the available arguments of .Find method.
This is what I would do:
Dim maxrows&, iRow&, iCol&, zcell As Range
maxrows = Excel.Rows.Count
If Selection.Count = 1 Then
iRow = Target.Row
iCol = Target.Column
Set zcell = Range(Cells(3, iCol), Cells(maxrows, iCol)).Find(vbNullString)
zcell.Select
End If