JohnTester
New Member
- Joined
- Sep 25, 2018
- Messages
- 9
Good day.
I have a workbook utilizing columns A to S.
Column C time and date stamps any changes made in Column D
Column I for J and Column L for K.
Once all the needed information is captured I select between Yes or No in Column S.
Should it reflect "Yes" in Column S, the entire row must be moved to the Tab labeled "POD"
I have been searching the internet and found some Macros. The problem is that I cannot get them to work. (little knowledge about this stuff)
Below are the current Macros I am using, which gives only errors.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("D:D"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
Set WorkRng = Intersect(Application.ActiveSheet.Range("J:J"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
I have a workbook utilizing columns A to S.
Column C time and date stamps any changes made in Column D
Column I for J and Column L for K.
Once all the needed information is captured I select between Yes or No in Column S.
Should it reflect "Yes" in Column S, the entire row must be moved to the Tab labeled "POD"
I have been searching the internet and found some Macros. The problem is that I cannot get them to work. (little knowledge about this stuff)
Below are the current Macros I am using, which gives only errors.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("D:D"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
Set WorkRng = Intersect(Application.ActiveSheet.Range("J:J"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
VBA Code:
Set WorkRng = Intersect(Application.ActiveSheet.Range("K:K"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
Sub Cheezy()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Sales Orders").UsedRange.Rows.Count
J = Worksheets("POD").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("POD").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Sales Orders").Range("S1:S" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "YES" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("POD").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "YES" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End If
End Sub