Avoiding copy/paste, selection to transfer data in VBA

[ItalianPlatinum]

Looking for a way to transfer a set of data over to another sheet after i set a filter without copy, selecting or pasting.

1. Sheet 1: filtered to not show blanks
   1. Want to transfer the data left showing
2. Sheet 2: Where I want to transfer the data to
3. Columns match up like this:
   1. Column A to Column A13 down
   2. Column I to Column B13 down
   3. Column J to Column C13 down
   4. so on and so on.....

 

[Peter_SSs]

Looks to be working!! Thank you.

No problem

But i can't promise you I won't find something in a few days in my testing ?

Understood.

 

[ItalianPlatinum]

So you want to transfer rows where both column I is not blank and column C = "INC"?

If so, try

Sub TransferData_v3()
  Dim vCols As Variant, vRows As Variant
  Dim i As Long, k As Long

  vCols = Array(1, 9, 10, 11, 2, 3, 4, 5, 6, 7, 8)  '<- Columns of interest in specified order
  With Sheets("Periodic")
    With .Range("A1:K" & .Range("I" & Rows.Count).End(xlUp).Row)
      If .Rows.Count > 2 Then
        vRows = Application.Index(.Cells, Evaluate("row(1:" & .Rows.Count & ")"), Array(9, 3))
        For i = 3 To UBound(vRows)
          If Len(vRows(i, 1)) > 0 And UCase(vRows(i, 2)) = "INC" Then
            k = k + 1
            vRows(k, 1) = i
          End If
        Next i
      Sheets("Compare").Range("A13").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With
End Sub

I am not sure if this question warrants a new thread or I can use this one. The above code i have been using for 2 years. I would like to use it for my other data set it just has a few minor differences (criteria) than the above like column Q = "Yes" and Column P = "true" as criteria to transfer over. Would someone mind helping me explain the above? This way I can amend for future needs. any help is much appreciated.

 

[Peter_SSs]

Would someone mind helping me explain the above?

This is the best I can do

Sub TransferData_v3()
  Dim vCols As Variant, vRows As Variant
  Dim i As Long, k As Long
  
  'Columns of interest in specified order
  vCols = Array(1, 9, 10, 11, 2, 3, 4, 5, 6, 7, 8)
  
  With Sheets("Periodic")
    With .Range("A1:K" & .Range("I" & Rows.Count).End(xlUp).Row)
      'Data does not start until row 3 so check that there is at least 3 rows
      If .Rows.Count > 2 Then
        'Read the relevant data into an array
        'The Evaluate makes a sequence of row numbers from 1 up to the last row in col I that has data
        'Array(9, 3) grabs the values from each row from col 9 (I) and then col 3 (C)
        vRows = Application.Index(.Cells, Evaluate("row(1:" & .Rows.Count & ")"), Array(9, 3))
        'Skip the 2 header rows and start at row 3
        For i = 3 To UBound(vRows)
          'If the first value in that row of vRows (originally Col I) > 0
          'and the second value in that row of vRows (originally Col C) is "INC" then
          If Len(vRows(i, 1)) > 0 And UCase(vRows(i, 2)) = "INC" Then
            'Increase counter by 1 and record the row number (re-using the vRows array)
            k = k + 1
            vRows(k, 1) = i
          End If
        Next i
      'Use the row numbers recorded in vRows to grab the values from the relevant columns and in the correct order
      'as defined in vCols near the start of this code
      Sheets("Compare").Range("A13").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With
End Sub

 

[ItalianPlatinum]

Thanks Pete. I am going to do some effort on this to see if I can use your helpful notes to try to modify this myself. If I have issues would it be ok if i reach back out?

I posted another thread as i felt like it needed a new post. but wanted a way to paste the destination to a new open row. i am not sure if that is an easy modification?

      'premise destination is empty - new scenario is not the case
      Sheets("Compare").Range("A13").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)

Modify existing VBA to transfer data over

Hello - I have existing VBA that works as intended transferring data over to another sheet. i have to add a 2nd occurrence of a transfer from another sheet. Therefore I am having difficulty to transfer over to the next open row of the destination sheet. is anyone also to assist? Sub...

www.mrexcel.com

 

[ItalianPlatinum]

Ok I gave it a try but am stuck i tried a lot of different variations - this i think is the closet but i get an error at this code:

only two coniditons it should be easy col P = TRUE and col Q = YES. so array changes from (9,3) to (16,17) then the UCASE changes from a condition of LEN to what i have right?

                If UCase(vRows(i, 1)) = "TRUE" And UCase(vRows(i, 2)) = "YES" Then

'transfer PD data over to Compare tab
  vCols = Array(1, 2, 3, 4, 8, 9, 10, 11) '<- Columns of interest in specified order
  With WsSP
    With .Range("A1:K" & .Range("H" & rows.count).End(xlUp).row)
        'Data does not start until row 3 so check that there is at least 3 rows
        If .rows.count > 2 Then
            'Read the relevant data into an array
            'The Evaluate makes a sequence of row numbers from 1 up to the last row in col I that has data
            'Array(9, 3) grabs the values from each row from col 9 (I) and then col 3 (C)
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(16, 17))
            'Skip the 2 header rows and start at row 3
            For i = 3 To UBound(vRows)
            'If the first value in that row of vRows (originally Col I) > 0
            'and the second value in that row of vRows (originally Col C) is "INC" then
                If UCase(vRows(i, 1)) = "TRUE" And UCase(vRows(i, 2)) = "YES" Then
                    'Increase counter by 1 and record the row number (re-using the vRows array)
                    k = k + 1
                    vRows(k, 1) = i

 

[ItalianPlatinum]

I got it further but now stuck here

WsDIST.Range("A2").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)

 

[Peter_SSs]

I'm lost.

 

[ItalianPlatinum]

Hey Peter - I repurposed the VBA per your helpful notes. I have 2 conditions to meet column Q = Yes and Column P = True. below is the modifications but when doing so I get application defined or object-defined error at

      WsDIST.Range("A2").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)

Ill wait on post #44 for now

'transfer PD data over to Compare tab
  vCols = Array(1, 2, 3, 4, 8, 9, 10, 11) '<- Columns of interest in specified order
  With WsSP1
    With .Range("A1:Q" & .Range("H" & rows.count).End(xlUp).row)
        'Data does not start until row 3 so check that there is at least 3 rows
        If .rows.count > 2 Then
            'Read the relevant data into an array
            'The Evaluate makes a sequence of row numbers from 1 up to the last row in col I that has data
            'Array(9, 3) grabs the values from each row from col 9 (I) and then col 3 (C)
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(16, 17))
            'Skip the 2 header rows and start at row 3
            For i = 3 To UBound(vRows)
            'If the first value in that row of vRows (originally Col I) > 0
            'and the second value in that row of vRows (originally Col C) is "INC" then
                If UCase(vRows(i, 1)) = "TRUE" And UCase(vRows(i, 2)) = "YES" Then
                    'Increase counter by 1 and record the row number (re-using the vRows array)
                    k = k + 1
                    vRows(k, 1) = i
        End If
      Next i
      'Use the row numbers recorded in vRows to grab the values from the relevant columns and in the correct order
      'as defined in vCols near the start of this code
      WsDIST.Range("A2").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With

 

[Peter_SSs]

Column P = True

Is that a text True or a logical True (v. False)?

If that does not resolve the issue, could we have a small set of sample data with XL2BB to test with?

 

[ItalianPlatinum]

A text True here is the snip of the code if it matters

'Fomulas for Review (PD File)
With WsSP1
lr = .Cells(rows.count, "A").End(xlUp).row
    .Range("P3:P" & lr).Formula = "=OR(I3<>"""",K3<>"""")"
    .Range("Q3:Q" & lr).Formula = "=IF(B3=TEXT(TODAY(),""YYYYMMDD"")+0,""YES"",""No"")"
    .Range("I3:Q" & lr).Value = .Range("I3:Q" & lr).Value
    .Range("I2:Q2") = Array("Acc", "Cl", "Exposure", "Tick", "Date", "Type", "Rt", "D or F", "Current Day Date")
    .Columns("A:Q").EntireColumn.AutoFit
End With