VBA Code to move entire row of data based on multiple number criteria

[Pi_Lover]

Good morning. I am attempting to transfer entire lines of data from one worksheet (Index) to the next available row in another worksheet (Available) I have tried the below code but, it is not transferring any data at all. Any ideas on what I may be doing wrong? Additional pertinent info is that I will want it to transfer the data if conditions are met in any of 12 columns. Meaning that if column AG is > 1 then transfer it from/to. But, if that column is not > 0 but column AP > 0 then transfer to/from, and so on with more columns. See below for the code I input but have had no success with. Any help would be greatly appreciated

Sub TransferRows()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Set wsSource = ThisWorkbook.Sheets("Index")
    Set wsDestination = ThisWorkbook.Sheets("Available")

    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        If wsSource.Cells(i, "AG").Value > 0 Or wsSource.Cells(i, "AP").Value > 0 Then
            wsSource.Rows(i).Copy wsDestination.Rows(wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1)
        End If
    Next i
End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your "Index" sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Pi_Lover]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your "Index" sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

I tried to add in the XL2BB on my Excel addins option, but there is no option to do so. May be that I am on a company laptop. Any ideas on a work around for that?

 

[mumps]

Could you upload the file as I described in Post #2?

 

[mumps]

if conditions are met in any of 12 columns

What are the 12 columns? If any of those columns has a value of greater than zero, you want to copy the entire row. Is this correct? Do you want to copy the row or move it? Please clarify in detail.

 

[Pi_Lover]

What are the 12 columns? If any of those columns has a value of greater than zero, you want to copy the entire row. Is this correct? Do you want to copy the row or move it? Please clarify in detail.

the 12 columns are as follows: AG, AP, AY, BH, BQ, BZ, CI, CR, DA, DJ, DS, and EB

I have to run to a meeting. I will work on uploading a sample spreadsheet set up like this one (too much proprietary info on it) as soon as I get back to my desk

 

[Pi_Lover]

Could you upload the file as I described in Post #2?

Dropbox

www.dropbox.com

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long, lRow2 As Long
    Set srcWS = Sheets("Index")
    Set desWS = Sheets("Available")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    v = srcWS.Range("A2:A" & lRow).Resize(, 6).Value
    For i = LBound(v) To UBound(v)
        If WorksheetFunction.Sum(Intersect(Rows(i + 1), Range("AG:AG, AP:AP, AY:AY, BH:BH, BQ:BQ, BZ:BZ, CI:CI, CR:CR, DA:DA, DJ:DJ, DS:DS,EB:EB"))) > 0 Then
            With desWS
                lRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                srcWS.Rows(i + 1).Copy .Range("A" & lRow2)
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Pi_Lover]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long, lRow2 As Long
    Set srcWS = Sheets("Index")
    Set desWS = Sheets("Available")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    v = srcWS.Range("A2:A" & lRow).Resize(, 6).Value
    For i = LBound(v) To UBound(v)
        If WorksheetFunction.Sum(Intersect(Rows(i + 1), Range("AG:AG, AP:AP, AY:AY, BH:BH, BQ:BQ, BZ:BZ, CI:CI, CR:CR, DA:DA, DJ:DJ, DS:DS,EB:EB"))) > 0 Then
            With desWS
                lRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                srcWS.Rows(i + 1).Copy .Range("A" & lRow2)
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Worked like a charm man. Thank you for your help with this. Much appreciated!

 

[mumps]

You are very welcome.