I have a code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim ltr, rNum, AlphaLtrs
AlphaLtrs = "ABCDEFGHIGKLMNOPQRSTUVWXYZ"
selLtr = Application.RoundUp(Rnd() * 26, 0)
ltr = Mid(AlphaLtrs, selLtr, 1)
rNum = Application.RoundUp(Rnd() * 999999, 0)
ActiveCell.Value = ltr & rNum
Target.Offset(0, 1).Select
End Sub
what I need is, to change the doubleclick function into Enter
and also if possible can I add the value of Column A in to the generated code beginning like Jeans-A545145
This adds a value to any cell that selected in column B, as long as only one cell is selected. Paste it into the code module for that sheet:
EDIT: Not sure if this is what you want, but now only does it if Target cell is empty:
EDIT 2: Woops, found a bug in the IF. If you select more than one cell, it errors on the IF Target.Value = "" part. I separated that into a second IF:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ltr, rNum, AlphaLtrs, selLtr
If Not Intersect(Target, Me.Columns(2)) Is Nothing And _
Target.Cells.Count = 1 Then
If Target.Value = "" Then
AlphaLtrs = "ABCDEFGHIGKLMNOPQRSTUVWXYZ"
selLtr = Application.RoundUp(Rnd() * 26, 0)
ltr = Mid(AlphaLtrs, selLtr, 1)
rNum = Application.RoundUp(Rnd() * 999999, 0)
Target.Value = Me.Range("A" & Target.Row) & "-" & ltr & rNum
End If
End If
End Sub
Perhaps:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim ltr, rNum, AlphaLtrs
AlphaLtrs = "ABCDEFGHIGKLMNOPQRSTUVWXYZ"
selLtr = Application.RoundUp(Rnd() * 26, 0)
ltr = Mid(AlphaLtrs, selLtr, 1)
rNum = Application.RoundUp(Rnd() * 999999, 0)
ActiveCell.Value = ltr & rNum
Target.Offset(0, 1).Select
Application.EnableEvents = True
End Sub
Related
Below is an example I found to hide/open complete rows in Excel with a doubleclick.
It works for a few lines but if I want to do this for 100 lines it's a terrible job.
Is it possible to make this more code-friendly?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(0, 0) = "A9" Then
Cancel = True
Rows("10:15").Hidden = Not Rows("10:15").Hidden
End If
If Target.Address(0, 0) = "A16" Then
Cancel = True
Rows("17:22").Hidden = Not Rows("17:22").Hidden
End If
If Target.Address(0, 0) = "A23" Then
Cancel = True
Rows("24:29").Hidden = Not Rows("24:29").Hidden
End If
If Target.Address(0, 0) = "A30" Then
Cancel = True
Rows("31:36").Hidden = Not Rows("31:36").Hidden
End If
If Target.Address(0, 0) = "A37" Then
Cancel = True
Rows("38:43").Hidden = Not Rows("38:43").Hidden
End If
If Target.Address(0, 0) = "A44" Then
Cancel = True
Rows("45:50").Hidden = Not Rows("45:50").Hidden
End If
Try this:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 1 Then Exit Sub
Dim r As Long
r = Target.Row
If (r - 2) Mod 7 = 0 And r > 2 Then
Rows(r + 1).Resize(6).Hidden = Not (Rows(r + 1).Resize(6).Hidden)
Cancel = True
End If
End Sub
You can use this code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 9 then Exit Sub
If (Target.Row - 2) Mod 7 = 0 Then 'e.g. 9, 16, 23, 30
hideRows Target.Row + 1
End If
End Sub
Private Sub hideRows(startRow As Long)
With Me.Rows(startRow).Resize(6)
.Hidden = Not .Hidden
End With
End Sub
UPDATE after #foxfires comment:
If you like the expand/collapse idea, you can use this code:
Public Sub groupRows(ws As Worksheet)
Dim c As Range
Set c = ws.Cells(9, 1)
While LenB(c.Text) > 0
c.Offset(1).Resize(6).EntireRow.Group
Set c = c.Offset(7)
Wend
With ws.Outline
.SummaryRow = xlSummaryAbove
.ShowLevels 1
End With
End Sub
I have a macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If VarType(v) <> vbDate Then
Application.EnableEvents = False
If v Like "???##" Or v Like "???-##" Then Target.Value = Left(v, Len(v) - 2) & "20" & Right(v, 2)
If VarType(Target.Value) <> vbDate Then Target.Value = Empty
Target.NumberFormat = "m/d/yyyy"
Application.EnableEvents = True
End If
End Sub
When copying (ex: may20, may-20) from another column to column A in Excel itself with this macro, it allows to paste only once - the next cell is no longer pasted, apparently, the clipboard is cleared after the first paste. I have to copy again from another column. How it can be corrected?
See below - if you need to paste the same value again.
The core problem is that the change event always clears the clipboard - there's no (easy) way I'm aware of to prevent that.
Private Sub Worksheet_Change(ByVal Target As Range)
Const MNTH_NM As String = "[A-Z][A-Z][A-Z]" 'a bit better than "???"
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If Len(v) > 0 Then
Application.EnableEvents = False
If UCase(v) Like MNTH_NM & "##" Or UCase(v) Like MNTH_NM & "-##" Then
v = Left(v, 3) & "-20" & Right(v, 2)
Target.NumberFormat = "m/d/yyyy"
Target.Value = v
Target.Copy
Else
Target.ClearContents 'if doesn't match the pattern, clear it
End If
Application.EnableEvents = True
End If 'non-zero length
End Sub
Want sequence to start on Cell A4. so that A4 is 1, A5 is 2 et al to A1004 = 1004
Tried changing [Range("A" & I)..] to [Range("A4" & I)..]
Tried changing I=4
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
I = 1
Application.EnableEvents = False
For I = 1 To 1000
Range("A" & I).Value = I
Next
Range("A1010").Value = ""
Application.EnableEvents = True
End Sub
Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
Set startRng = Cells(4, 1)
Application.EnableEvents = False
For I = 0 To 999
startRng.Offset(I, 0) = I
Next
Range("A1010").Value = ""
Application.EnableEvents = True
End Sub
how to adjust this code, so that it works for the whole column and not only for one cell?
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
With Target
If .Address = Range("A11:A1").Address Then
Select Case .Value
Case "Excel"
.Value = "Word"
Case "Word"
.Value = "Outlook"
Case "Outlook"
.Value = "Excel"
Case Else
.Value = "Word"
End Select
End If
End With
Range("A2").Select
Application.EnableEvents = True
End Sub
Thank you very much!
Jeame
As follows but you are setting up a recurring chain if you select A2 at the end and your target is column A. I have removed.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Column = 1 Then 'example column A
With Target
Select Case .Value
Case "Excel"
.Value = "Word"
Case "Word"
.Value = "Outlook"
Case "Outlook"
.Value = "Excel"
Case Else
.Value = "Word"
End Select
End With
End If
Application.EnableEvents = True
End Sub
Edit:
Following on from a change to requirements please see a re-write of your code. The Test sub is just for testing the event.
Option Explicit
Private Sub Test()
Call Worksheet_BeforeDoubleClick(Selection, True)
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then
Dim var As Long
Dim targetRange As Range
var = Target.Row
Set targetRange = ActiveSheet.Range("A" & var & ":B" & var) '2 columns of interest for row that was triggered
With targetRange.Columns(2)
Select Case LCase(.Value) 'i.e. column B's value. Add add change to lowercase so test always matches
Case "active"
targetRange.Interior.ColorIndex = 16
.Value = "Finished"
Case "wip"
targetRange.Interior.ColorIndex = 2
.Value = "Done"
End Select
End With
End If
End Sub
Too complicated solution for me. Below is the code, which should work similar but with double click. Before I only did data valiation - listbox with two options. But somehow it does not work to me.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Var = Target.Row
var2 = "b" + Var
If (Target.Column = 2) Then
If (Range(var2).Value = "Active") Then
var2 = "a" + Var
Range(var2).Interior.ColorIndex = 16
var2 = "b" + Var
Range(var2).Interior.ColorIndex = 16
Range(var2).Value = "Finished"
Else
Var = "b" + Var
If (Range(var2).Value = "WIP") Then
var2 = "a" + Var
Range(var2).Interior.ColorIndex = 2
var2 = "b" + Var
Range(var2).Interior.ColorIndex = 2
Range(var2).Value = "DONE"
End If
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Having trouble with time formatting.
I have set the cell to custom format 00:00.
Currently in column A a date is inputted, this can be as 0300 which converts to 03:00 which is perfect or you can just enter 03:00.
I now have a problem if a user enters 03;00 as i need this to display 03:00
how can i ensure that all times are in the hh:mm format and not in hh;mm etc.
This needs to auto change on input for anything in column A, except what is the header (A1:A5) although this should not be affected.
Thanks
On your sheets change event you would place the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 And Target.Column = 1 And Target.Row > 5 Then
Target.Value2 = Replace(Target.Value2, ";", ":")
End If
End Sub
Explaining the code... it first checks to make sure that the change isn't on multiple cells (ie paste) and that the change is on column A below Row 5. If it does pass the conditional it simply replaces ; for :.
This does what i require.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim xStr As String
Dim xVal As String
Set rng1 = Range("A:A")
Set rng2 = Range("C:C")
Set rng3 = Range("I:I")
On Error GoTo EndMacro
If Application.Intersect(Target, Union(rng1, rng2, rng3)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Row < 5 Then Exit Sub
Application.EnableEvents = False
With Target
If Not .HasFormula Then
Target.Value = Replace(Target.Value, ";", ":")
Target.Value = Left(Target.Value, 5)
xVal = .Value
Select Case Len(xVal)
Case 1 ' e.g., 1 = 00:01 AM
xStr = "00:0" & xVal
Case 2 ' e.g., 12 = 00:12 AM
xStr = "00:" & xVal
Case 3 ' e.g., 735 = 07:35 AM
xStr = "0" & Left(xVal, 1) & ":" & Right(xVal, 2)
Case 4 ' e.g., 1234 = 12:34
xStr = Left(xVal, 2) & ":" & Right(xVal, 2)
Case 5 ' e.g., 12:45 = 12:45
xStr = Left(xVal, 2) & Mid(xVal, 2, 1) & Right(xVal, 2)
Case Else
Err.Raise 0
End Select
.Value = Format(TimeValue(xStr), "hh:mm")
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
Application.EnableEvents = True
End Sub
Thanks