I am trying to build a VBA code which would do the following task
Whenever there is an entry in the Name column the VBA will automatically generate id's for each row.
id Name
NL-1 abc
NL-2 fljf
NL-3 fdgfd
NL-4 dsfsd
NL-5 dsfdsf
I am using the following VBA script and it works fine when it is just numbers.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber, x As Long
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Rows.Count > 1 Then Exit Sub
If Cells(Target.Row, 1) > 0 Then Exit Sub
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
The output of above code
id Name
1 abc
2 ada
3 skfn
But when I try to introduce "NL=" in the code thats where I am facing problems.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber, x As Long
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Rows.Count > 1 Then Exit Sub
If Cells(Target.Row, 1) > 0 Then Exit Sub
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = "NL-" & maxNumber + 1
End If
End Sub
The output of this code is
id Name
NL-1 abc
NL-1 ada
NL-1 skfn
Please let me know if someone can figure this out. This would be a huge help.
Thanks.
Related
I'm trying to introduce Checkboxes into my personal project Planning, unfortunately normal Checkboxes tend to bug out, so I found this side here and am trying to convert it into a macro to select the rows I want checks at. Specifically the last one that is NOT "Mutually Exclusive" but with data validation.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=879
Unfortunately it does not let me make it into a macro like I wanted to and I spent a lot of time trying already. :(
Please Help
I tried to write a SelectionRng. Or searched for a way to write it into a Macro to select it in the Worksheet.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Interior.ColorIndex = 44
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Target.Interior.ColorIndex = 0
Cancel = True
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Select a specific subset of the range "Ckboxes"
Select Case Target.Address
Case Else
'Populate the cell to the right of Target with its status
If Target.Value = "a" Then
Target.Offset(0, 6) = "Checked"
Else:
Target.Offset(0, 6).Value = "Not Checked"
End If
End Select
End Sub
so i have a sheet and whenever something in the range of A10:A23 is changed/updated, it is supposed to put a timestamp in the according column in Row B, however it isnt working and i have no idea why.
I already set the sheets code to "Worksheet" and "change"
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = A And Target.Column >= 10 And Target.Column <= 23 Then
Cells(Target.Column, B) = Now()
End If
End Sub
Thanks in advance!
Assuming you will only change one cell at a time (which is not always true):
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A10:A23")) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If
End If
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
I've found some examples of how to highlight the row of the currently selected cell. My issue is that I need to do this only in rows 3 and higher.
This is what I picked up so far:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
With Target
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
This works as advertised, but I am struggling with how to not lose the background color I have for header cells in rows 1 and 2. I am sure it requires an "if" of some sort, but I am not sure where I need to put it.
Also, is there anyway I can apply this to the entire workbook? I have 60 sheets in the workbook and if I can not replicate the code 60 times that would be ideal.
Any help is greatly appreciated.
The following code will do the trick:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row <> 1 and Target.Row <> 2 Then
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = 0
Range("A1:AF2").Interior.ColorIndex = 47
Target.EntireRow.Interior.ColorIndex = 8
Application.ScreenUpdating = True
End If
End Sub
you place this in ThisWorkbook instead of the specific Sheet.
the code:
If Target.Row <> 1 and Target.Row <> 2 Then
Checks if Target.Row does not equal Row 1 and 2
I am very novice at this, I need to apply the below to rows with VBA, can anyone advise please.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A59")) Is Nothing Then
Range("B59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B59")) Is Nothing Then
Range("C59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C59")) Is Nothing Then
Range("D59:E59").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("D59")) Is Nothing Then
Range("E59").ClearContents
End If
End With
I have five dependent dropdown list columns each one is dependent of the previous. I am trying to reset the cells once the previous column selection is changed. The above works fine but I do not know how to apply it to all rows or up to 10000 rows for example.
I would very much appreciate the guidance on this
Many thanks
G
If you don't want to use a loop, you can try something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row = 59 then
If not IsEmpty(Target) then
Range(Cells(59,Target.Column +1),Cells(59,"E")).ClearContents
End If
End If
End Sub
Try this one:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count > 1 Then Exit Sub
If .Row >= 59 And .Row <= 10000 _
And .Column <= 4 Then
Range(Cells(.Row, .Column + 1), Cells(.Row, 5)).ClearContents
End If
End With
End Sub