Home > Software design >  How do I modify this VBA to copy and paste, but paste starting in column "B"?
How do I modify this VBA to copy and paste, but paste starting in column "B"?

Time:12-21

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.

  • Related