I modified this barrowed code for my book, but I cannot get the paste to start with column "B". It works beautifully as is, starting the paste in column "A", but I need to it start in column "B".
If sheet InventoryAvailability column U equals "X", then copy entire row.
CODE:
Sub MoveRowBasedOnCellValueX()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("InventoryAvailability").UsedRange.Rows.Count
J = Worksheets("CountSheet").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("CountSheet").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("InventoryAvailability").Range("U4:U" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "X" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("CountSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next
Application.ScreenUpdating = True
End Sub
I tried changing Range("A" & Rows.Count) to Range("B" & Rows.Count), but no joy. It runs and nothing happens. I change Range("B" & Rows.Count) back to Range("A" & Rows.Count), and it copies and pastes starting in column "A".
Please help me understand what I am doing and/or understanding incorrectly.
CodePudding user response:
If you have the EntireRow
you can't offset the pasting range because it would go off the sheet. I've corrected this by changing the Copy
region to only be in the used range.
Option Explicit
Sub MoveRowBasedOnCellValueX()
Dim xRg As Range
Dim xCell As Range
Dim ColWide As Long
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("InventoryAvailability").UsedRange.Rows.Count
J = Worksheets("CountSheet").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("CountSheet").UsedRange) = 0 Then J = 0
End If
With Worksheets("InventoryAvailability")
Set xRg = .Range("U4:U" & I)
ColWide = .UsedRange.Column .UsedRange.Columns.Count
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "X" Then
.Range("A" & xRg(K).row).Resize(1, ColWide).Copy Destination:=Worksheets("CountSheet").Range("B" & Rows.Count).End(xlUp).Offset(1)
End If
Next
Application.ScreenUpdating = True
End With
End Sub
Something to consider: If this operation is taking longer than a few seconds to accomplish, you should consider pulling all the data into an array, filtering out the stuff you don't need there, then placing the whole data chunk on your destination sheet. it will be much faster... likely less than a second.