ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,699
- Office Version
- 2007
- Platform
- Windows
Hi,
As per title & below are the two codes if possible to be merged into one.
In my head i see that if i double click a cell in column C then run that code BUT if i double click a cell in column A then run this code.
As per title & below are the two codes if possible to be merged into one.
In my head i see that if i double click a cell in column C then run that code BUT if i double click a cell in column A then run this code.
Rich (BB code):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("C6", Cells(Rows.Count, "C").End(xlUp)), Target) Is Nothing Then
Cancel = True
Dim WB As Workbook, DestWB As Workbook
Dim WS As Worksheet, DestWS As Worksheet
Dim rng As Range, rngDest As Range
Dim ColArr As Variant, SCol As Variant, DCol As Variant
On Error Resume Next
Set DestWB = Application.Workbooks("KEY CODES.xlsm")
If DestWB Is Nothing Then
Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"
Set DestWB = Application.Workbooks("KEY CODES.xlsm")
End If
On Error GoTo 0
Set WB = ThisWorkbook
On Error Resume Next
Set WS = WB.Worksheets("DATABASE")
On Error GoTo 0
If WS Is Nothing Then
MsgBox "Worksheet 'DATABASE' IS MISSING"
Exit Sub
End If
Set DestWS = DestWB.Worksheets("KEYCODES")
ColArr = Array("D:A", "C:B", "J:C", "K:D")
Dim DestNextRow As Long
With DestWS
If IsEmpty(.Range("A" & 1)) Then
DestNextRow = 1
Else
DestNextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End If
End With
Application.ScreenUpdating = False
For Each SCol In ColArr
DCol = Split(SCol, ":")(1)
SCol = Split(SCol, ":")(0)
With WS
Set rng = .Cells(Target.Row, SCol)
End With
With DestWS
Set rngDest = .Range(DCol & DestNextRow)
End With
rng.Copy
rngDest.PasteSpecial Paste:=xlPasteValues
rngDest.Borders.Weight = xlThin
rngDest.Font.Size = 14
rngDest.Font.Bold = True
rngDest.HorizontalAlignment = xlCenter
rngDest.Cells.Interior.ColorIndex = 6
rngDest.Cells.RowHeight = 25
Next SCol
Application.ScreenUpdating = True
End If
With ActiveWorkbook ' THIS WILL SAVE & CLOSE KEY CODES WORKBOOK
.Save
.Saved = True
.Close
End With
End Sub
Rich (BB code):
Private Sub OpenCustomerInDatabase_Click()
If Intersect(Range("A6", Cells(Rows.Count, "A").End(xlUp)), Target) Is Nothing Then Exit Sub
Cancel = True
Database.LoadData Me, Target.Row
End Sub