Double click function not perform

[Vincent88]

Hi Guys,
My code is to copy a cell value to its four adjacent cells. I have already encoded to paste cells except those patterned and non empty cells but it does not copy the value to the weekend cells with color RGB(255,245,230. Please advise where goes wrong ?

TestDropDownList_3.xlsm
	A	B						H	I	J	K	L	M	N	O	P	Q	R
1	MDate	Attendance						1-Feb	2-Feb	3-Feb	4-Feb	5-Feb	6-Feb	7-Feb	8-Feb	9-Feb	10-Feb	11-Feb
2	Date	Summary						1	2	3	4	5	6	7	8	9	10	11
3	Larry Q	T:16 L:0.5 D:2.5 E:0 N:0									D				D
4	Mandy H	T:16 L:0.5 D:3.5 E:0 N:0									K			D	K
5	John G	T:16 L:0 D:1 E:2 N:0
202202

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=Data!$P$2:$P14
A3	List	=Data!$P$2:$P$14
A4	List	=Data!$P$2:$P$13
A5:A6	List	=Data!$P$2:$P$12

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
    If sh.Name = "Data" Then Exit Sub
  
    Application.ScreenUpdating = False
     
On Error Resume Next

Dim lrow As Long
Dim Lcol As Long
Dim rngArea As Range
Dim wkend As Boolean
Dim pat As Double

lrow = Range("A" & Rows.Count).End(xlUp).Row
Lcol = Cells(1, Columns.Count).End(xlToLeft).Column

Set rngArea = Range(Cells(3, 8), Cells(lrow, Lcol))

Debug.Print rngArea.Address

If Not Intersect(Target, rngArea) Is Nothing Then
    Cancel = True
    If Not IsEmpty(Target.Value) Then                       
      'Target.Offset(, 1).Resize(, 4).Value = Target.Value
      For col4 = 1 To 4
           Dim adjcell As Range
           Set adjcell = Target.Offset(, col4)
           adjcellpat = Target.Offset(, col4).Interior.Pattern
           adjcellcol = Target.Offset(, col4).Interior.Color
           If adjcellpat <> -4142 Then                                                                        'Cells with any pattern
                        'No value to be pasted 
              ElseIf Target.Offset(, col4).Interior.Color = RGB(255, 245, 230) Then       'Color in weekend column
                       Target.Offset(, col4).Value = Target.Value
                                      
                ElseIf adjcell.Interior.Color = 16777215 And adjcell.Value = "" And adjcell.Interior.Pattern = xlNone Then                'Other blank cells, no pattern and no color
                       Target.Offset(, col4).Value = Target.Value      'Workable
                    
              
           Else
           End If
      Next col4
    
    
    
    
    Else
'ON/OFF FORMATTING CELLS TO PATTERN
'https://www.mrexcel.com/board/threads/error-before-double-click-function.1185307/#post-5774690
'Post 4 Joe4
  
  
'   Get interior pattern number
    pat = Target.Interior.Pattern
  
'   Check to see if weekend
    wkend = IsWeekend(Cells(1, Target.Column))
  
    '   Check to see if it has no lined pattern at all
        'pattern -4142 = xlPatternNone  and pattern 1 = xlPatternSolid
        If (pat = -4142) Or (pat = 1) Then
            Target.Interior.Pattern = xlPatternUp               ' or xlPatternLightVertical
            Target.Interior.PatternColor = RGB(166, 166, 166)
        Else
  
    '       Check to see if it has lined pattern
            'If pat = -4162 Then               'Pattern -4162 = xlPatternUp only
            If Not IsEmpty(pat) Then           'Applicable to any pattern
    '           Check to see if weekend
                If wkend = True Then
                    Target.Interior.Pattern = xlNone
                    Target.Interior.Color = RGB(255, 245, 230)
                Else
                    Target.Interior.Pattern = xlNone
                End If
            End If
        End If
    End If
End If

 

[My Aswer Is This]

I always like it when posters tell me in specific details what there trying to achieve
Rather then provide very few details and then show me a long script that does not work for them.
Would you please explain with specific details what your wanting to do and let me write the code the way I like to do it. Thanks

 

[Vincent88]

Hi, What I would like is to copy the target cell value to the next 4 adjacent cells. If those adjacent cells are patterned, colored and non empty then skip it but the weekend cells in color RG(255, 245, 230) should also be pasted the value if it is empty and non patterned.