I have 3 worksheets in the workbook called Shop_Turnover, Cmpltd and WeekendLECs.
The Shop_Turnover has a dropdown in Columns K and M that contains Cmpltd.
I want the below items to be macros.
I want to move the entire row to the Cmpltd worksheet only after by Columns K and M contain the Cmpltd entry.
I also want to copy these same rows to the WeekendLECs worksheet.
I have some code that works for moving the entire row based on Column K but adding the Column M criteria has me stumped.
SHOP_TURNOVER worksheet code:
The Shop_Turnover has a dropdown in Columns K and M that contains Cmpltd.
I want the below items to be macros.
I want to move the entire row to the Cmpltd worksheet only after by Columns K and M contain the Cmpltd entry.
I also want to copy these same rows to the WeekendLECs worksheet.
I have some code that works for moving the entire row based on Column K but adding the Column M criteria has me stumped.
SHOP_TURNOVER worksheet code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call MoveBasedOnValue
End If
Next
Application.EnableEvents = True
End Sub
[B]Module 1 code:[/B]
Sub MoveBasedOnValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("SHOP_TURNOVER").UsedRange.Rows.Count
B = Worksheets("WeekendLECs").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("WeekendLECs").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("SHOP_TURNOVER").Range("K1:K" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Cmpltd" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("WeekendLECs").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Cmpltd" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub