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]

One slight issue just noticed the column 8 or column H is not transferring over and not sure why to the destination area of column K

Which code from which post are you using?
If it is the second code (_v2) from post 24 then unfortunately I made one of the same mistakes in that code as referred to here ..

I should also mention

• My earlier code resulted in one row and one column of the results missing - corrected below assuming Option Base has not been set to 1.

If it was that code, try editing this line

Sheets("Compare").Range("A13").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, vRows, vCols)

 

[ItalianPlatinum]

Which code from which post are you using?
If it is the second code (_v2) from post 24 then unfortunately I made one of the same mistakes in that code as referred to here ..



If it was that code, try editing this line

Sheets("Compare").Range("A13").Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, vRows, vCols)

That was it! Apologies I must've missed that.

One last thing I noticed in my testing and this scenario could occur. if the file is empty and there is nothing to transfer. the code will error with below message. It really should only be run with data; but at times I may not know until running. Is it possible to purge, warn the user or avoid the error? There is a field on the file used to transfer from located at the end of the data where it will count the records. Example: A3 = TL; B3 = 0 (for empty file)

 

[Peter_SSs]

That was it! Apologies I must've missed that.

No, it was my mistake, not yours.

Try adding in these 4 blue lines of code where shown.

  With Sheets("Periodic")
    With .Range("A1:K" & .Range("I" & Rows.Count).End(xlUp).Row)
      If .Rows.Count > 2 Then
        vRows = .Columns(9).Value
        For i = 3 To UBound(vRows)
          If Len(vRows(i, 1)) > 0 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, vRows, vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With

 

[ItalianPlatinum]

No, it was my mistake, not yours.

Try adding in these 4 blue lines of code where shown.

  With Sheets("Periodic")
    With .Range("A1:K" & .Range("I" & Rows.Count).End(xlUp).Row)
      If .Rows.Count > 2 Then
        vRows = .Columns(9).Value
        For i = 3 To UBound(vRows)
          If Len(vRows(i, 1)) > 0 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, vRows, vCols)
      Else
        MsgBox "No data to transfer"
      End If
    End With
  End With

Alright Pete here is the next dilemma because I have this embedded into a process (right in dead center of the process). If there is no data to transfer it should seize the whole process. when not it is doing things on sheets it shouldn't because it proceeds without the transferred data the other tasks needs.

 

[Peter_SSs]

Structure like this then?

Sub Example()
  If Sheets("Periodic").Range("I" & Rows.Count).End(xlUp).Row > 2 Then
    'All the rest of the code here
    
  Else
    MsgBox "No data"
  End If
End Sub

If not that, then it might relate to the following but I do not know what sheet that is on.
.. and I don't know what A3 = TL means of if it is related to whether there is data or not

There is a field on the file used to transfer from located at the end of the data where it will count the records. Example: A3 = TL; B3 = 0 (for empty file)

 

[ItalianPlatinum]

Structure like this then?

Sub Example()
  If Sheets("Periodic").Range("I" & Rows.Count).End(xlUp).Row > 2 Then
    'All the rest of the code here
   
  Else
    MsgBox "No data"
  End If
End Sub

If not that, then it might relate to the following but I do not know what sheet that is on.
.. and I don't know what A3 = TL means of if it is related to whether there is data or not

Hey Peter and Merry Christmas - I had to rearrange a few things but got it to work. But raised a bigger issue that I think warrants another thread. Seeing it is a new topic surrounding stopping the VBA altogether if multiple files don't exist. So I don't think I can fully apply your code until I solve that issue, can't have the vba keep going when the file doesnt exist along with a helper file

 

[Peter_SSs]

I had to rearrange a few things but got it to work.

Good news.

But raised a bigger issue that I think warrants another thread.

OK, fair enough.

 

[ItalianPlatinum]

Good news.


OK, fair enough.

Pete one variable that would be a nice to have and you did sort of ask in post #24. I am filtering by the below to transfer the data. So the data will transfer all non blank values; but not the 2nd criteria.

.Range("2:2").Autofilter field:=9, Criteria1:="<>"
.Range("2:2").Autofilter field:=3, Criteria1:="INC"

 

[Peter_SSs]

Pete one variable that would be a nice to have and you did sort of ask in post #24. I am filtering by the below to transfer the data. So the data will transfer all non blank values; but not the 2nd criteria.

.Range("2:2").Autofilter field:=9, Criteria1:="<>"
.Range("2:2").Autofilter field:=3, Criteria1:="INC"

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

 

[ItalianPlatinum]

Looks to be working!! Thank you. But i can't promise you I won't find something in a few days in my testing ?