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]

Have the 12 columns changed?

No sir, all columns are the same

 

[mumps]

Are the values (IWP) in column B unique values?

 

[Pi_Lover]

Are the values (IWP) in column B unique values?

Those are temporary and will be replaced once those numbers are generated. Every value in the IWP column will be repeated, some more than others

 

[mumps]

it will continue copying over repetitive data. Meaning it will copy over the same row again

In order to avoid this problem, we need a unique identifier for each row. Are the values in column C, Instrument_Name, unique?

 

[Pi_Lover]

In order to avoid this problem, we need a unique identifier for each row. Are the values in column C, Instrument_Name, unique?

Yes sir, each of those will be unique

 

[mumps]

OK. We'll use those values. Give me a little time to work on it.

 

[mumps]

This seems to work with the last file you posted.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long, lRow2 As Long, fnd As Range
    Set srcWS = Sheets("Index")
    Set desWS = Sheets("Available")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    v = srcWS.Range("C2:C" & lRow).Value
    For i = LBound(v) To UBound(v)
        Set fnd = desWS.Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            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
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Pi_Lover]

This seems to work with the last file you posted.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long, lRow2 As Long, fnd As Range
    Set srcWS = Sheets("Index")
    Set desWS = Sheets("Available")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    v = srcWS.Range("C2:C" & lRow).Value
    For i = LBound(v) To UBound(v)
        Set fnd = desWS.Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            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
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Hmm. Now it's not working at all on mine. What could I be doing wrong?

 

[Pi_Lover]

This seems to work with the last file you posted.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long, lRow2 As Long, fnd As Range
    Set srcWS = Sheets("Index")
    Set desWS = Sheets("Available")
    lRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    v = srcWS.Range("C2:C" & lRow).Value
    For i = LBound(v) To UBound(v)
        Set fnd = desWS.Range("C:C").Find(v(i, 1), LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            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
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Disregard that last comment. My UserForm is dropping the number in as text. once i convert it to a number then it works perfectly with no repetitive copy overs.

Any idea on how to get my UserForm to drop the value in as a number rather than text?

 

[mumps]

If the text is in a textbox on the userform, try multiplying the value by 1 in your code, for example: Textbox1.text*1 .