Automatically move content

[Xplaywrightt]

I need help with an excel VBA code for a sch. proj. pls. The code moves contents from a "2C" sheet when cell contains the text "Less Than 30" to a final sheet name "<30day." The current code moves the entire column from "2C" to column A in "Less Than 30", I want it to move it to column B in "Less Than 30" because I want to put something in column A.


The current code clears what I put in column A of "Less Than 30" when run.


Im not a coder and this code is from a YouTuber (Excel 10)

Below is the attached 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("AK:AK")) Is Nothing Then Exit Sub


Application.EnableEvents = False


For Z = 1 To Target.Count


If Target (Z). Value > 0 Then


Call CopyRowBasedOnCellValue


End If


Next


Application.EnableEvents = True


End Sub


Sub CopyLessThan30Days2C()


Dim xRg As Range


Dim Cell As Range


Dim A As Long

Dim B As Long


Dim C As Long


A = Worksheets ("2C").UsedRange.Rows.Count


B=


Worksheets ("<30days").UsedRange.Rows.Count


If B = 1 Then


If


Application.WorksheetFunction.CountA(Worksheets


("<30days").UsedRange) = 0 Then B = 0


End If


Set xRg = Worksheets ("2C").Range("AK1:AK" & A)


On Error Resume Next


Application.ScreenUpdating = False


For C = 1 To xRg.Count


If CStr(×Rg(C).Value) = "Less Than 30" Then


XRg(C).EntireRow.Copy


Destination:=Worksheets ("<30days").Range ("A" & B


+ 1)


B=B+ 1


End If

Worksheets"<30days").UsedRange.RemoveDuplic ates Columns: =1, Header:=xIYes


Worksheets ("<30days").UsedRange.SpecialCells(xl


CellTypeBlanks).Delete xIShiftUp


Next


Application.ScreenUpdating = True


End Sub

 

[Anonymous1378]

Try changing xRg(C).EntireRow.Copy Destination:=Worksheets("<30days").Range("A" & B + 1) to xRg(C).EntireRow.Copy Destination:=Worksheets("<30days").Range("B" & B + 1)?

 

[Xplaywrightt]

Try changing xRg(C).EntireRow.Copy Destination:=Worksheets("<30days").Range("A" & B + 1) to xRg(C).EntireRow.Copy Destination:=Worksheets("<30days").Range("B" & B + 1)?

When I change it from A to B. Nothing now happens. No error message when running the code but nothing happens. But when I change back to A, it now moves the data but to the default column A.

 

[Anonymous1378]

How about ("<30days").UsedRange) = 0 Then B = 0 to ("<30days").UsedRange) = 0 Then B = 1?

 

[Xplaywrightt]

How about ("<30days").UsedRange) = 0 Then B = 0 to ("<30days").UsedRange) = 0 Then B = 1?

Thank you for the swift replies. Doing that still just moves it to column A

 

[Anonymous1378]

What does the function CopyRowBasedOnCellValue look like?

 

[Xplaywrightt]

What does the function CopyRowBasedOnCellValue look like?

I didn’t know why it was there because I don’t have a module named CopyRowBasedOnCellValue. I think it’s the YouTubers original name. So I removed that from there. And the module just starts with Sub CopyLessThan30Days2C()

This is the YouTube link:

What does the function CopyRowBasedOnCellValue look like?