Hi,
I have 2 change event macros that I want to combine. Wherever I add the 2nd macro it does not trigger.
Can anyone show me where it should go?
Thanks
Current change event macro:
2nd macro:
I have 2 change event macros that I want to combine. Wherever I add the 2nd macro it does not trigger.
Can anyone show me where it should go?
Thanks
Current change event macro:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count <> 16 Then Exit Sub
Dim KeyCells As Range
Set Target = ThisWorkbook.Worksheets("Sheet1").Range("F2")
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = ThisWorkbook.Worksheets("Sheet1").Range("A1:P50")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
'Count the cells to copy
Dim a As Integer
a = 0
For i = 5 To 50
If ThisWorkbook.Sheets("Sheet1").Cells(i, 1) <> "" Then
a = a + 1
End If
Next i
'Count the last cell where to start copying
Dim b As Integer
b = 2
For i = 2 To 50000
If ThisWorkbook.Sheets("Data").Cells(i, 1) <> "" Then
b = b + 1
End If
Next i
Dim c As Integer
c = 5
'Perform the copy paste process
Application.EnableEvents = False
For i = b To b + a - 1
If ThisWorkbook.Worksheets("Sheet1").Range("E2") <> "" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" And ThisWorkbook.Worksheets("Sheet1").Range("AB5") = "10" Then
ThisWorkbook.Sheets("Data").Cells(i, 1) = ThisWorkbook.Sheets("Sheet1").Cells(3, 14)
ThisWorkbook.Sheets("Data").Cells(i, 2) = ThisWorkbook.Sheets("Sheet1").Cells(2, 2)
ThisWorkbook.Sheets("Data").Cells(i, 3) = ThisWorkbook.Sheets("Sheet1").Cells(1, 1)
ThisWorkbook.Sheets("Data").Cells(i, 4) = ThisWorkbook.Sheets("Sheet1").Cells(2, 5)
ThisWorkbook.Sheets("Data").Cells(i, 5) = ThisWorkbook.Sheets("Sheet1").Cells(c, 26)
ThisWorkbook.Sheets("Data").Cells(i, 6) = ThisWorkbook.Sheets("Sheet1").Cells(c, 1)
ThisWorkbook.Sheets("Data").Cells(i, 7) = ThisWorkbook.Sheets("Sheet1").Cells(c, 6)
ThisWorkbook.Sheets("Data").Cells(i, 8) = ThisWorkbook.Sheets("Sheet1").Cells(c, 8)
ThisWorkbook.Sheets("Data").Cells(i, 9) = ThisWorkbook.Sheets("Sheet1").Cells(c, 15)
ThisWorkbook.Sheets("Data").Cells(i, 10) = ThisWorkbook.Sheets("Sheet1").Cells(c, 16)
ThisWorkbook.Sheets("Data").Cells(i, 11) = ThisWorkbook.Sheets("Sheet1").Cells(3, 2)
ThisWorkbook.Sheets("Data").Cells(i, 12) = ThisWorkbook.Sheets("Sheet1").Cells(c, 25)
ThisWorkbook.Sheets("Data").Cells(i, 13) = ThisWorkbook.Sheets("Sheet1").Cells(c, 7)
ThisWorkbook.Sheets("Data").Cells(i, 14) = ThisWorkbook.Sheets("Sheet1").Cells(c, 2)
ThisWorkbook.Sheets("Data").Cells(i, 15) = ThisWorkbook.Sheets("Sheet1").Cells(c, 3)
ThisWorkbook.Sheets("Data").Cells(i, 16) = ThisWorkbook.Sheets("Sheet1").Cells(c, 4)
ThisWorkbook.Sheets("Data").Cells(i, 17) = ThisWorkbook.Sheets("Sheet1").Cells(c, 5)
ThisWorkbook.Sheets("Data").Cells(i, 18) = ThisWorkbook.Sheets("Sheet1").Cells(c, 9)
ThisWorkbook.Sheets("Data").Cells(i, 19) = ThisWorkbook.Sheets("Sheet1").Cells(c, 12)
ThisWorkbook.Sheets("Data").Cells(i, 20) = ThisWorkbook.Sheets("Sheet1").Cells(c, 13)
ThisWorkbook.Sheets("Data").Cells(i, 21) = ThisWorkbook.Sheets("Sheet1").Cells(c, 10)
ThisWorkbook.Sheets("Data").Cells(i, 22) = ThisWorkbook.Sheets("Sheet1").Cells(c, 11)
c = c + 1
End If
Next i
Application.EnableEvents = True
End If
Dim lastcell As Range
Dim wsStore As Worksheet
Set wsStore = ThisWorkbook.Worksheets("Store")
Set lastcell = wsStore.Cells(wsStore.Rows.Count, 1).End(xlUp)
With ThisWorkbook.Worksheets("Sheet1").Range("F2")
're-set F2 when last cell of the Store sheet is no longer the same as the value in N3
If .Value = "Closed" And Val(.ID) <> xlOff Then
.ID = xlOff
Call CopyToStore
Call ClearData
ElseIf .Offset(1, 8).Value <> lastcell.Value Then
.ID = xlOn
End If
End With
End Sub
2nd macro:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If ThisWorkbook.Worksheets("Sheet1").Range("F2") = "Closed" Then
ThisWorkbook.Worksheets("Sheet1").Range("Q2").Value = 30
End If
If ThisWorkbook.Worksheets("Sheet1").Range("E2") = "Not In Play" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" Then
ThisWorkbook.Worksheets("Sheet1").Range("Q2").Value = 1
End If
If ThisWorkbook.Worksheets("Sheet1").Range("E2") = "In Play" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" Then
ThisWorkbook.Worksheets("Sheet1").Range("Q2").Value = 0.2
End If
Application.EnableEvents = True
End Sub