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

 

[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

OK, I've ran into an issue. When I run it repeatedly, it will continue copying over repetitive data. Meaning it will copy over the same row again. Also, row 2 data won't copy over unless there are values in another row(s)

 

[Pi_Lover]

And it also copying over data that hases no values entered into the respective columns that are being looked at. Any ideas?

 

[mumps]

A macro that works with sample data most often won't work with the actual data. I would need a file that is exactly representative of your actual data. Can you upload a file with 10 or 12 rows of data that contains all possible scenarios of how your data is organized? Please clarify in detail what to look for using a few examples from the data and referring to specific cells, rows, columns and sheets.

 

[Pi_Lover]

A macro that works with sample data most often won't work with the actual data. I would need a file that is exactly representative of your actual data. Can you upload a file with 10 or 12 rows of data that contains all possible scenarios of how your data is organized? Please clarify in detail what to look for using a few examples from the data and referring to specific cells, rows, columns and sheets.

Unfortunately, I cannot. Too much proprietary information on the spreadsheet. Let me work on modifying that data real quick and then upload a copy

 

[Pi_Lover]

A macro that works with sample data most often won't work with the actual data. I would need a file that is exactly representative of your actual data. Can you upload a file with 10 or 12 rows of data that contains all possible scenarios of how your data is organized? Please clarify in detail what to look for using a few examples from the data and referring to specific cells, rows, columns and sheets.

WIll it work if I "N/A" all the cells proprietary data?

 

[mumps]

"N/A" indicates an error in Excel. Just replace with generic data..... 10 to 12 rows.

 

[Pi_Lover]

"N/A" indicates an error in Excel. Just replace with generic data..... 10 to 12 rows.

I wonder if that may be the problem. There is existing cells with N/A in them from the original document

 

[mumps]

OK. Put "N/A" all the cells proprietary data I'll see if that works.

 

[Pi_Lover]

OK. Put "N/A" all the cells proprietary data I'll see if that works.

I just dropped in number values into each cell. See below for link

Dropbox

www.dropbox.com

 

[mumps]

Have the 12 columns changed?