# 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## ZVI

Hi,

Do all in VBA, including blank rows skipping.

Copy source data columns into VBA arrays.
Loop *those arrays*, skip empty data *in arrays*, populate *resulting VBA array*, copy data *from the resulting array to the destination range.*

But take into the account a total size of data in the source arrays (refer to your e.t.c. and unknown rows count).
Big size slows speed down, data can be swapped on disk (it's very slow), or even hangs the code.
In such a case process the source data chunk by chunk.


----------



## ItalianPlatinum

ZVI said:


> Hi,
> 
> Do all in VBA, including blank rows skipping.
> 
> Copy source data columns into VBA arrays.
> Loop them, skip empty rows, populate destination array, copy result to the destination range.
> 
> But take into the account a total size of data in the source arrays (refer to your e.t.c. and unknown rows count).
> Big size slows speed down, data can be swapped on disk (it's very slow), or even hangs the code.
> In such a case process the source data chunk by chunk.


So the data could be large that is where I was seeing if there is a quicker way and copying using clipboard. Or are you proposing copy all the data over then in the new sheet purge the data i want to see? Wouldn't be sure what is the best avenue and most efficient


----------



## ZVI

ItalianPlatinum said:


> ... Or are you proposing copy all the data over then in the new sheet purge the data i want to see?


No, my proposing is in copy data of the source columns (not all the data from Sheet1) into VBA arrays (not to the Sheet2), prepare resulting data in VBA array and after that copy that data from resulting array to the Sheet2. See also my warnimg about big size.
You've highlighted a problem with a big data in a clipboard - try copying the filtered columns one by one, this can (or can't) speed up, but testing is required.

P.S. See updated words in Bold in my previous post #2


----------



## ZVI

How long does it take now using copy-paste?
Is there a separate column in Sheet1 to filter data without empty rows?


----------



## ItalianPlatinum

ZVI said:


> How long does it take now using copy-paste?
> Is there a separate column to filter out empty rows?


No timer yet not built am worried if I went the copy/Paste route I would lose time seeing I plan to do a lot of steps. I wanted to leverage the below to transfer the date but I dont believe it will work with filtered data. The below would transfer all?



		VBA Code:
__


With Sheets("TREND")
  rws = .Range("A2:A2").End(xlDown).row - 1
  Sheets("COMPARE").Range("A13").Resize(rws, 1).Value = .Range("A13").Resize(rws).Value
End With


----------



## ZVI

ItalianPlatinum said:


> No timer yet not built am worried if I went the copy/Paste route I would lose time seeing I plan to do a lot of steps. I wanted to leverage the below to transfer the date but I dont believe it will work with filtered data. The below would transfer all?
> 
> 
> 
> VBA Code:
> __
> 
> 
> With Sheets("TREND")
> rws = .Range("A2:A2").End(xlDown).row - 1
> Sheets("COMPARE").Range("A13").Resize(rws, 1).Value = .Range("A13").Resize(rws).Value
> End With


That code copies all data, including data hidden by filter.


----------



## ZVI

Try this instead:


		VBA Code:
__


Sub Test1()
  
  With Sheets("TREND")
    .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy Sheets("COMPARE").Range("A13")
  End With
  
End Sub


----------



## ZVI

ItalianPlatinum said:


> ...copy all the data over then in the new sheet purge the data i want to see?


This can be also the way - depends on how you filter blank data, see my 2nd question in the post #5


----------



## ItalianPlatinum

ZVI said:


> Try this instead:
> 
> 
> VBA Code:
> __
> 
> 
> Sub Test1()
> 
> With Sheets("TREND")
> .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Copy Sheets("COMPARE").Range("A13")
> End With
> 
> End Sub


ok it is starting to get a little slow and its copy over the formatting of my destination 



		VBA Code:
__


'Paste data over
  With Workbooks("Compare").Sheets("Periodic")
    .Range("A3", .Cells(.rows.count, "A").End(xlUp)).Copy Sheets("Compare").Range("A13")
    .Range("I3", .Cells(.rows.count, "I").End(xlUp)).Copy Sheets("Compare").Range("B13")
    .Range("J3", .Cells(.rows.count, "J").End(xlUp)).Copy Sheets("Compare").Range("C13")
    .Range("K3", .Cells(.rows.count, "K").End(xlUp)).Copy Sheets("Compare").Range("D13")
    .Range("B3", .Cells(.rows.count, "B").End(xlUp)).Copy Sheets("Compare").Range("E13")
    .Range("C3", .Cells(.rows.count, "C").End(xlUp)).Copy Sheets("Compare").Range("F13")
    .Range("D3", .Cells(.rows.count, "D").End(xlUp)).Copy Sheets("Compare").Range("G13")
    .Range("E3", .Cells(.rows.count, "E").End(xlUp)).Copy Sheets("Compare").Range("H13")
    .Range("F3", .Cells(.rows.count, "F").End(xlUp)).Copy Sheets("Compare").Range("I13")
    .Range("G3", .Cells(.rows.count, "G").End(xlUp)).Copy Sheets("Compare").Range("J13")
    .Range("H3", .Cells(.rows.count, "G").End(xlUp)).Copy Sheets("Compare").Range("K13")
  End With


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ZVI has asked about *how *you have filtered for blanks (see post 5). I would also like to know that. 
For example, have you just filtered column A of the source data to not show blanks?
Has the filtering been done manually or by code? If by code, could we see that code?


----------



## ItalianPlatinum

Peter_SSs said:


> ZVI has asked about *how *you have filtered for blanks (see post 5). I would also like to know that.
> For example, have you just filtered column A of the source data to not show blanks?
> Has the filtering been done manually or by code? If by code, could we see that code?


Column I or field 9 on the source file not on the destination



		VBA Code:
__


'Fomulas for Review (File)
With Workbooks("Compare").Sheets("Periodic")
lr = Cells(rows.count, "A").End(xlUp).row
.Range("I3:I" & lr).Formula = "=IFERROR(VLOOKUP(A3,'Table'!$F:$K,4,FALSE),"""")"
.Range("J3:J" & lr).Formula = "=IFERROR(VLOOKUP(A3,'Table'!$F:$K,5,FALSE),"""")"
.Range("L3:L" & lr).Formula = "=IF(I3<>"""",B3,"""")"
.Range("M3:M" & lr).Formula = "=IF(I3<>"""",C3,"""")"
.Range("N3:N" & lr).Formula = "=IF(I3<>"""",D3,"""")"
.Range("O3:O" & lr).Formula = "=IF(I3<>"""",E3,"""")"
.Range("P3:P" & lr).Formula = "=IF(I3<>"""",F3,"""")"
.Range("Q3:Q" & lr).Formula = "=IF(I3<>"""",G3,"""")"
.Range("R3:R" & lr).Formula = "=IF(I3<>"""",H3,"""")"
.Columns("A:R").EntireColumn.AutoFit
.Range("I3:R" & lr).Value = .Range("I3:R" & lr).Value
.Range("2:2").AutoFilter Field:=9, Criteria1:="<>"
End With

  With Workbooks("Compare").Sheets("Periodic")
    .Range("A3", .Cells(.rows.count, "A").End(xlUp)).Copy Sheets("Compare").Range("A13")
    .Range("I3", .Cells(.rows.count, "I").End(xlUp)).Copy Sheets( Compare").Range("B13")
    .Range("J3", .Cells(.rows.count, "J").End(xlUp)).Copy Sheets("Compare").Range("C13")
    .Range("K3", .Cells(.rows.count, "K").End(xlUp)).Copy Sheets("Compare").Range("D13")
    .Range("B3", .Cells(.rows.count, "B").End(xlUp)).Copy Sheets("Compare").Range("E13")
    .Range("C3", .Cells(.rows.count, "C").End(xlUp)).Copy Sheets("Compare").Range("F13")
    .Range("D3", .Cells(.rows.count, "D").End(xlUp)).Copy Sheets("Compare").Range("G13")
    .Range("E3", .Cells(.rows.count, "E").End(xlUp)).Copy Sheets("Compare").Range("H13")
    .Range("F3", .Cells(.rows.count, "F").End(xlUp)).Copy Sheets("Compare").Range("I13")
    .Range("G3", .Cells(.rows.count, "G").End(xlUp)).Copy Sheets("Compare").Range("J13")
    .Range("H3", .Cells(.rows.count, "H").End(xlUp)).Copy Sheets("Compare").Range("K13")
  End With

'Fomulas for Review (N)
With Workbooks("Compare").Sheets("Compare")
lr = Cells(rows.count, "D").End(xlUp).row
.Range("L13:L" & lr).Formula = "=IFERROR(VALUE(TEXT(VLOOKUP(D13,IF(F13=""INC"",'D'!$A:$Y,'DS'!$A:$Y),2,0),""YYYYMMDD"")),"""")"
.Range("M13:M" & lr).Formula = "=IFERROR(VALUE(VLOOKUP(D13,IF(F13=""INC"",'D'!$A:$Y,' DS'!$A:$Y),3,0)),"""")"
.Range("N13:N" & lr).Formula = "=IFERROR(VALUE(TEXT(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),19,0),""YYYYMMDD"")),"""")"
.Range("O13:O" & lr).Formula = "=IFERROR(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),22,0),"""")"
.Range("P13:P" & lr).Formula = "=IF(ISERROR(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),23,0)),,VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),23,0))"
.Range("Q13:Q" & lr).Formula = "=IFERROR(VALUE(TEXT(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),17,0),""YYYYMMDD"")),"""")"
.Range("R13:R" & lr).Formula = "=IFERROR(VALUE(TEXT(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),18,0),""YYYYMMDD"")),"""")"
.Range("S13:S" & lr).Formula = "=IFERROR(VLOOKUP(D13,IF(F13=""INC"",' D'!$A:$Y,' DS'!$A:$Y),8,0),"""")"
.Range("T13:T" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",IF(E13=N13,""OK"",""CHECK""))"
.Range("U13:U" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",IF(CONCATENATE(F13,O13)=""INCD"",""OK"",""CHECK""))"
.Range("V13:V" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",(G13-P13))"
.Range("W13:W" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",IF(H13=Q13,""OK"",""CHECK""))"
.Range("X13:X" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",IF(I13=R13,""OK"",""CHECK""))"
.Range("Y13:Y" & lr).Formula = "=IF(OR(B13=0,B13="""",C13=98),"""",IF(K13=S13,""OK"",""CHECK""))"
.Range("L13:Y" & lr).Value = .Range("L13:Y" & lr).Value
End With

End Sub


----------



## Peter_SSs

What workbook is that code in?


----------



## Peter_SSs

ItalianPlatinum said:


> so on and so on.....


BTW, what does this actually mean in post 1?


----------



## ItalianPlatinum

Peter_SSs said:


> What workbook is that code in?


Same workbook I bring all the data into one sheet then move to another sheet


----------



## ItalianPlatinum

Peter_SSs said:


> BTW, what does this actually mean in post 1?


Kind of a moot point now seeing I provided the full code in #12, but another term for etc. Or it continues.


----------



## Peter_SSs

Peter_SSs said:


> BTW, what does this actually mean in post 1?


OK, I think I can see this in the code now. Sorry.


----------



## ZVI

What is the 'Table' in this formula: VLOOKUP(A3,'Table'!$F:$K,4,FALSE) ?


----------



## ItalianPlatinum

ZVI said:


> What is the 'Table' in this formula: VLOOKUP(A3,'Table'!$F:$K,4,FALSE) ?


Another sheet in the workbook with static information


----------



## ZVI

Avoid referencing full columns 'Table'!$F:$K because it dramatically slows down such a formula:
VLOOKUP(A3,'Table'!*$F:$K*,4,FALSE)


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ItalianPlatinum said:


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


OK, give this a try with a copy of your workbook



		VBA Code:
__


Sub TransferData()
  Dim vRows As Variant, vCols As Variant

  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)
      vRows = Filter(Application.Transpose(Evaluate(Replace("if(len(#),if(row(#)>2,row(#),""x""),""x"")", "#", .Columns(9).Address(External:=True)))), "x", False)
      Sheets("Compare").Range("A13").Resize(UBound(vRows), UBound(vCols)).Value = Application.Index(.Cells.Value, Application.Transpose(vRows), vCols)
    End With
  End With
End Sub


----------



## ZVI

Hi Peter,
It's impressive & short code! 
The only limitation is an array limit of the Application.Transpose:


		VBA Code:
__


Debug.Print UBound(Application.Transpose(Range("A1:A100000")))

Not sure if it's critical - depends on max number of data rows in the sheet "Periodic".


----------



## ZVI

Another solution to test:


		VBA Code:
__


Sub TransferData1()
 
  Dim a() As Variant
  Dim Sh1 As Worksheet, Sh2 As Worksheet
  Dim Rng1 As Range, Rng2 As Range
  Dim i As Long, j As Long
 
  ' Set variables for sheets and ranges
  Set Sh1 = Sheets("Periodic")
  Set Sh2 = Sheets("Compare")
  i = Sh1.Cells(Rows.Count, "A").End(xlUp).Row ' Last data row
  Set Rng1 = Sh1.Range("A3").Resize(i - 2)
  Set Rng2 = Sh2.Range("A3").Resize(i - 2)
 
  ' Copy the not filtered data
  Rng2.Columns("A").Value = Rng1.Columns("A").Value
  Rng2.Columns("B:D").Value = Rng1.Columns("I:K").Value
  Rng2.Columns("E:I").Value = Rng1.Columns("B:F").Value
 
  ' Get filter  criteria from Rng1.Columns("I")
  a() = Rng1.Columns("I").Value
  For j = 1 To UBound(a)
    If Len(a(j, 1)) <> 0 Then a(j, 1) = 1
  Next
 
  ' Freeze
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  ' Filter using an extra column, it's fast
  Sh2.Columns(1).Insert xlShiftToRight
  With Rng2.Offset(, -1).Resize(, 10)
    .Columns(1).Value = a()
    .Sort .Cells(1), xlAscending, Header:=xlNo
    j = .Cells(1).Offset(UBound(a)).End(xlUp).Row
    If i > j Then .Rows(j - .Row + 2 & ":" & i).ClearContents
  End With
  Sh2.Columns(1).Delete
 
  ' Unfreeze
  Application.ScreenUpdating = True
  Application.EnableEvents = True
 
End Sub


----------



## Peter_SSs

I forgot to mention that my codes (& I think Vlad's?) do not require column I to be Filtered for blanks. In fact, if you are only doing that to get the non-blank data to the other sheet then it would be better to *not *filter it first as it will save some time.

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.
Formula recalculation due to filtering, column insertion etc could affect speed of code. However, the only recalculations that my codes should trigger are if there are any formulas that are triggered by changes to sheet 'Compare' A13:K13 and below
Code corrected from post 21


		Rich (BB code):
__


Sub TransferData()
  Dim vRows As Variant, vCols As Variant

  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)
      vRows = Filter(Application.Transpose(Evaluate(Replace("if(len(#),if(row(#)>2,row(#),""x""),""x"")", "#", .Columns(9).Address(External:=True)))), "x", False)
      Sheets("Compare").Range("A13").Resize(UBound(vRows) *+ 1*, UBound(vCols) *+ 1*).Value = Application.Index(.Cells.Value, Application.Transpose(vRows), vCols)
    End With
  End With
End Sub




ZVI said:


> The only limitation is an array limit of the Application.Transpose:


Hi Vlad
Yes, that could be a problem. Need to know the size of the data as you say.
Or I could fill the vRows array looping in a similar way to you have with your 'a' array above. In testing up to about 200,000 rows the time difference between my earlier code and the one below is negligible. These codes for me are running 2 - 3 times faster than the post 23 code but that may not be relevant as it produces different results to mine - see my results below.



		VBA Code:
__


Sub TransferData_v2()
  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)
      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)).Value = Application.Index(.Cells.Value, vRows, vCols)
    End With
  End With
End Sub


My (small) sample data

ItalianPlatinum_1.xlsmABCDEFGHIJK12Hdr 1Hdr 2Hdr 3Hdr 4Hdr 5Hdr 6Hdr 7Hdr 8Hdr 9Hdr 10Hdr 11339523037516667150414843457572578597131237064543815451281378130626793574405782355216283275262066459077441867283222162319414976371935401144314946841881038771477162645776221131139154193714114890128218563789807161609995138123589104056677768714437223605267285571686015338381934159841210471636617415809520821526174577833667686458661888179798888177433273919269780939153385239416202222269572295641521909198867481662817Periodic

.. and corresponding results (using v2 code)

ItalianPlatinum_1.xlsmABCDEFGHIJK133950414852303751666711434237064575725785971311579162832357440578235521651867226206645907744178260999518563789807161188177687235891040566719437168607223605267285520312104738381934159842188332739179798888177422262394169780939153385Compare


----------



## ItalianPlatinum

Peter_SSs said:


> I forgot to mention that my codes (& I think Vlad's?) do not require column I to be Filtered for blanks. In fact, if you are only doing that to get the non-blank data to the other sheet then it would be better to *not *filter it first as it will save some time.
> 
> 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.
> Formula recalculation due to filtering, column insertion etc could affect speed of code. However, the only recalculations that my codes should trigger are if there are any formulas that are triggered by changes to sheet 'Compare' A13:K13 and below
> Code corrected from post 21
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub TransferData()
> Dim vRows As Variant, vCols As Variant
> 
> 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)
> vRows = Filter(Application.Transpose(Evaluate(Replace("if(len(#),if(row(#)>2,row(#),""x""),""x"")", "#", .Columns(9).Address(External:=True)))), "x", False)
> Sheets("Compare").Range("A13").Resize(UBound(vRows) *+ 1*, UBound(vCols) *+ 1*).Value = Application.Index(.Cells.Value, Application.Transpose(vRows), vCols)
> End With
> End With
> End Sub
> 
> 
> 
> Hi Vlad
> Yes, that could be a problem. Need to know the size of the data as you say.
> Or I could fill the vRows array looping in a similar way to you have with your 'a' array above. In testing up to about 200,000 rows the time difference between my earlier code and the one below is negligible. These codes for me are running 2 - 3 times faster than the post 23 code but that may not be relevant as it produces different results to mine - see my results below.
> 
> 
> 
> VBA Code:
> __
> 
> 
> Sub TransferData_v2()
> 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)
> 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)).Value = Application.Index(.Cells.Value, vRows, vCols)
> End With
> End With
> End Sub
> 
> 
> My (small) sample data
> 
> ItalianPlatinum_1.xlsmABCDEFGHIJK12Hdr 1Hdr 2Hdr 3Hdr 4Hdr 5Hdr 6Hdr 7Hdr 8Hdr 9Hdr 10Hdr 11339523037516667150414843457572578597131237064543815451281378130626793574405782355216283275262066459077441867283222162319414976371935401144314946841881038771477162645776221131139154193714114890128218563789807161609995138123589104056677768714437223605267285571686015338381934159841210471636617415809520821526174577833667686458661888179798888177433273919269780939153385239416202222269572295641521909198867481662817Periodic
> 
> .. and corresponding results (using v2 code)
> 
> ItalianPlatinum_1.xlsmABCDEFGHIJK133950414852303751666711434237064575725785971311579162832357440578235521651867226206645907744178260999518563789807161188177687235891040566719437168607223605267285520312104738381934159842188332739179798888177422262394169780939153385Compare


I am sorry for some reason I did not get any notifications from this thread. I downloaded the app on my phone -- since doing so I no longer recieved emails for each post. Anywho. I will test both now and see with my dataset. To confirm size of filet he max I expect this dataset to be is 10,000 rows. it should never surpass.


----------



## ItalianPlatinum

ZVI said:


> Another solution to test:
> 
> 
> VBA Code:
> __
> 
> 
> Sub TransferData1()
> 
> Dim a() As Variant
> Dim Sh1 As Worksheet, Sh2 As Worksheet
> Dim Rng1 As Range, Rng2 As Range
> Dim i As Long, j As Long
> 
> ' Set variables for sheets and ranges
> Set Sh1 = Sheets("Periodic")
> Set Sh2 = Sheets("Compare")
> i = Sh1.Cells(Rows.Count, "A").End(xlUp).Row ' Last data row
> Set Rng1 = Sh1.Range("A3").Resize(i - 2)
> Set Rng2 = Sh2.Range("A3").Resize(i - 2)
> 
> ' Copy the not filtered data
> Rng2.Columns("A").Value = Rng1.Columns("A").Value
> Rng2.Columns("B:D").Value = Rng1.Columns("I:K").Value
> Rng2.Columns("E:I").Value = Rng1.Columns("B:F").Value
> 
> ' Get filter  criteria from Rng1.Columns("I")
> a() = Rng1.Columns("I").Value
> For j = 1 To UBound(a)
> If Len(a(j, 1)) <> 0 Then a(j, 1) = 1
> Next
> 
> ' Freeze
> Application.ScreenUpdating = False
> Application.EnableEvents = False
> 
> ' Filter using an extra column, it's fast
> Sh2.Columns(1).Insert xlShiftToRight
> With Rng2.Offset(, -1).Resize(, 10)
> .Columns(1).Value = a()
> .Sort .Cells(1), xlAscending, Header:=xlNo
> j = .Cells(1).Offset(UBound(a)).End(xlUp).Row
> If i > j Then .Rows(j - .Row + 2 & ":" & i).ClearContents
> End With
> Sh2.Columns(1).Delete
> 
> ' Unfreeze
> Application.ScreenUpdating = True
> Application.EnableEvents = True
> 
> End Sub


I had to tweak one section   Set Rng2 = Sh2.Range("A3").Resize(i - 2) to   Set Rng2 = Sh2.Range("A13").Resize(i - 12)

Appears to be working formatting changes ever so slightly on my destination location. When running my formulas post it isn't calculating need to investigate further but if I input the formula in the cell it does. So i know it isnt a problem with the formula.


----------



## ItalianPlatinum

Peter_SSs said:


> I forgot to mention that my codes (& I think Vlad's?) do not require column I to be Filtered for blanks. In fact, if you are only doing that to get the non-blank data to the other sheet then it would be better to *not *filter it first as it will save some time.
> 
> 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.
> Formula recalculation due to filtering, column insertion etc could affect speed of code. However, the only recalculations that my codes should trigger are if there are any formulas that are triggered by changes to sheet 'Compare' A13:K13 and below
> Code corrected from post 21
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub TransferData()
> Dim vRows As Variant, vCols As Variant
> 
> 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)
> vRows = Filter(Application.Transpose(Evaluate(Replace("if(len(#),if(row(#)>2,row(#),""x""),""x"")", "#", .Columns(9).Address(External:=True)))), "x", False)
> Sheets("Compare").Range("A13").Resize(UBound(vRows) *+ 1*, UBound(vCols) *+ 1*).Value = Application.Index(.Cells.Value, Application.Transpose(vRows), vCols)
> End With
> End With
> End Sub
> 
> 
> 
> Hi Vlad
> Yes, that could be a problem. Need to know the size of the data as you say.
> Or I could fill the vRows array looping in a similar way to you have with your 'a' array above. In testing up to about 200,000 rows the time difference between my earlier code and the one below is negligible. These codes for me are running 2 - 3 times faster than the post 23 code but that may not be relevant as it produces different results to mine - see my results below.
> 
> 
> 
> VBA Code:
> __
> 
> 
> Sub TransferData_v2()
> 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)
> 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)).Value = Application.Index(.Cells.Value, vRows, vCols)
> End With
> End With
> End Sub
> 
> 
> My (small) sample data
> 
> ItalianPlatinum_1.xlsmABCDEFGHIJK12Hdr 1Hdr 2Hdr 3Hdr 4Hdr 5Hdr 6Hdr 7Hdr 8Hdr 9Hdr 10Hdr 11339523037516667150414843457572578597131237064543815451281378130626793574405782355216283275262066459077441867283222162319414976371935401144314946841881038771477162645776221131139154193714114890128218563789807161609995138123589104056677768714437223605267285571686015338381934159841210471636617415809520821526174577833667686458661888179798888177433273919269780939153385239416202222269572295641521909198867481662817Periodic
> 
> .. and corresponding results (using v2 code)
> 
> ItalianPlatinum_1.xlsmABCDEFGHIJK133950414852303751666711434237064575725785971311579162832357440578235521651867226206645907744178260999518563789807161188177687235891040566719437168607223605267285520312104738381934159842188332739179798888177422262394169780939153385Compare


looks to be working. formatting issues are also mitigated. seeing same issue as vlads where some formulas arent working. if both yours causing the formulas not to work it must be something with my formulas or last row potentially.


----------



## ItalianPlatinum

You both can disregard my formula issue it was on my end. i didnt lock my formulas correctly. thank you both i am going to further stress test but right now seems to be working as i expect


----------



## Peter_SSs

ItalianPlatinum said:


> max I expect this dataset to be is 10,000 rows. it should never surpass.


In that case the Application.Transpose issue that Vlad raised shouldn't be an issue so I expect that either of my codes should work (unless some other issue exists that I don't know about yet


----------



## ItalianPlatinum

Peter_SSs said:


> In that case the Application.Transpose issue that Vlad raised shouldn't be an issue so I expect that either of my codes should work (unless some other issue exists that I don't know about yet


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


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ItalianPlatinum said:


> 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 ..



Peter_SSs said:


> 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


		Rich (BB code):
__


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


----------



## ItalianPlatinum

Peter_SSs said:


> 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
> 
> 
> Rich (BB code):
> __
> 
> 
> 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

ItalianPlatinum said:


> 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.



		Rich (BB code):
__


  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

Peter_SSs said:


> No, it was my mistake, not yours.
> 
> Try adding in these 4 blue lines of code where shown.
> 
> 
> 
> Rich (BB code):
> __
> 
> 
> 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?



		VBA Code:
__


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


ItalianPlatinum said:


> 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

Peter_SSs said:


> Structure like this then?
> 
> 
> 
> VBA Code:
> __
> 
> 
> 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

ItalianPlatinum said:


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


Good news. 



ItalianPlatinum said:


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


OK, fair enough.


----------



## ItalianPlatinum

Peter_SSs said:


> 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.



		VBA Code:
__


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


----------



## Peter_SSs

ItalianPlatinum said:


> 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.
> 
> 
> 
> VBA Code:
> __
> 
> 
> .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


		VBA Code:
__


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 ?


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ItalianPlatinum said:


> Looks to be working!! Thank you.


 No problem




ItalianPlatinum said:


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


Understood.


----------



## ItalianPlatinum

Peter_SSs said:


> So you want to transfer rows where *both *column I is not blank *and *column C = "INC"?
> 
> If so, try
> 
> 
> VBA Code:
> __
> 
> 
> 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

ItalianPlatinum said:


> Would someone mind helping me explain the above?


This is the best I can do



		VBA Code:
__


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?



		VBA Code:
__


      '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?



		VBA Code:
__


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







		VBA Code:
__


'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 



		VBA Code:
__


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 
	
	
	
	
	
	




		VBA Code:
__


      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



		VBA Code:
__


'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

ItalianPlatinum said:


> 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



		VBA Code:
__


'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


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ItalianPlatinum said:


> A *text *True here is the snip of the code if it matters
> 
> 
> 
> Rich (BB code):
> __
> 
> 
> *   .Range("P3:P" & lr).Formula = "=OR(I3<>"""",K3<>"""")"*


That looks like a *logical *TRUE/FALSE result in column P to me. 

Try making this change in your code


		Rich (BB code):
__


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


----------



## ItalianPlatinum

But then I change it to a value using this 
	
	
	
	
	
	




		VBA Code:
__


    .Range("I3:Q" & lr).Value = .Range("I3:Q" & lr).Value


so would that make it a text?

Ok I tried that code and still same error at the same spot


----------



## Peter_SSs

ItalianPlatinum said:


> But then I change it to a value using this
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> VBA Code:
> __
> 
> 
> .Range("I3:Q" & lr).Value = .Range("I3:Q" & lr).Value
> 
> so would that make it a text?


No



ItalianPlatinum said:


> Ok I tried that code and still same error at the same spot


Run it again and when the error occurs, click Debug then hover over the variable k and tell us what value appear in the pop-up.


----------



## ItalianPlatinum

See below:






While hovering over vrows says subscript out of range? Take a look. same for (i, 2)


----------



## Peter_SSs

Thanks. k=0 (& the other things that you reported) indicates that no rows were found to meet your conditions & therefore the error makes sense as we cannot resize a range to be zero rows.
It looks like vRows may not be being populated how you think it is/should be.

Would need a small set of sample data with at least one row that you expect to meet the conditions to investigate further.
Also the other code that declares/defines WsSP1 and WsDIST


----------



## ItalianPlatinum

Thanks Peter you led me in the right direction. Some columns were inadvertently empty (Column I, J, L) therefore the conditions were met but there was nothing to transfer. the formulas were commented out during this testing and not put back in. I have since corrected that and it is operating. So 8 rows as expected were transferred over. 

In my post #44 and the thread that was closed. If i applied this transfer code for another sheet (same layout) to the same destination. how would i go about transferring data to the next available row in WsDist? the first code works because the sheet is empty. after the first run there is data in their so the 2nd run has a variable to deal with


----------



## Peter_SSs

ItalianPlatinum said:


> how would i go about transferring data to the next available row in WsDist?


In WsDist, for every row is there a value in column A? That is can we use column A (or some other fixed column) to determine the last row that contains data?

If not, can you confirm that it is columns A:H in WsDist that would need to be checked to find the last used row?


----------



## ItalianPlatinum

Yes Column A would always have data if there was data transferred the only columns that could be empty would be (F-J) while (A-E) will have columns populated


----------



## Peter_SSs

Then try something like this



		Rich (BB code):
__


Dim nrDist As Long '<- Put this at the top with other declarations

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

nrDist = WsDIST.Range("A" & Rows.Count).End(xlUp).Row + 1
WsDIST.Range("A" & nrDist).Resize(k, UBound(vCols) + 1).Value = Application.Index(.Cells.Value, Application.Index(vRows, 0, 1), vCols)


----------



## ItalianPlatinum

Thanks I think the 
	
	
	
	
	
	




		VBA Code:
__


("A" & nr)

 is suppose to be 
	
	
	
	
	
	




		VBA Code:
__


("A" & nrDist)

 right? ill make that modification

Not sure why I am struggling with modifying the 2nd iteration. Below looks like it would work but i get runtime 1004 at here 
	
	
	
	
	
	




		VBA Code:
__


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

. I just want to remove the 2 matching conditions to 1. With only column P as a condition. Do you see why it wouldn't work? when i hover over k it says 0 and subscript out of range on the matching criteria 
	
	
	
	
	
	




		VBA Code:
__


If UCase(vRows(i, 1)) = "Yes" Then

. Column P is the same as the prior so True/False. there should be 46 records to transfer. the data set will potentially and naturally have empty cells in Column I and J if column P is True is that causing problems?



		VBA Code:
__


'transfer CD 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:P" & .Range("H" & rows.count).End(xlUp).row)
        If .rows.count > 2 Then
            vRows = Application.Index(.Cells, Evaluate("row(1:" & .rows.count & ")"), Array(16))
            For i = 3 To UBound(vRows)
                If UCase(vRows(i, 1)) = "Yes" Then
                    k = k + 1
                    vRows(k, 1) = i
        End If
      Next i
        nrDist = WsDIST.Range("A" & rows.count).End(xlUp).row + 1
        WsDIST.Range("A" & nrDist).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


----------



## 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.

Sheet 1: filtered to not show blanks
Want to transfer the data left showing

Sheet 2: Where I want to transfer the data to 
Columns match up like this:
Column A to Column A13 down
Column I to Column B13 down
Column J to Column C13 down
so on and so on.....


----------



## Peter_SSs

ItalianPlatinum said:


> I think the
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> VBA Code:
> __
> 
> 
> ("A" & nr)
> 
> is suppose to be
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 
> VBA Code:
> __
> 
> 
> ("A" & nrDist)
> 
> right?


Yes, I have edited to correct that now. Thanks for picking that up.



ItalianPlatinum said:


> Below looks like it would work but i get runtime 1004 at here


If k=0 then the problem is occurring before this line of code. Looks like below would be an issue


ItalianPlatinum said:


> VBA Code:
> __
> 
> 
> If UCase(vRows(i, 1)) = "Yes" Then
> 
> .


That will *never *be true. It would need to be


		Rich (BB code):
__


If UCase(vRows(i, 1)) = "*YES*" Then


----------



## ItalianPlatinum

Interesting didn't realize Yes vs YES was that significant. I have made that change. if the column is True/False will YES still work or should I put it as TRUE? I am getting the same error message at same spot I hope having blank data in those columns are not interfering here?


----------



## ItalianPlatinum

ItalianPlatinum said:


> if the column is True/False will YES still work or should I put it as TRUE?


That is what it was. I will test in full tomorrow (start to end). unfortunately I wont be near my computer the rest of the day to test.


----------



## Peter_SSs

ItalianPlatinum said:


> didn't realize Yes vs YES was that significant.





		Rich (BB code):
__


*UCase*(vRows(i, 1))

 means upper case vRows(i, 1)


----------



## ItalianPlatinum

Peter_SSs said:


> means upper case vRows(i, 1)


😯

i am curious how this satifies. even though YES and TRUE are different they interact the same? does the opposite of NO and FALSE also apply?


		VBA Code:
__


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


----------



## Peter_SSs

ItalianPlatinum said:


> even though YES and TRUE are different they interact the same?


I think that you are misunderstanding the syntax
If vRows(i, 1) *And *UCase(vRows(i, 2)) = "YES" Then
is the same as
If *vRows(i, 1) = TRUE* *And* *UCase(vRows(i, 2)) = "YES"* Then
*Both *the red part and the blue part have to individually evaluate to TRUE for the code to proceed to whatever follows in the next line.

However, since vRows(i,1) is a *logical *value of TRUE or FALSE it is pointless the red part above saying
If *TRUE* = TRUE then *TRUE*
or
If *FALSE* = TRUE then *FALSE*
since the final bold result is identical to the initial bold value, which is the value already held in vRows(i,1)


----------



## ItalianPlatinum

So that was very helpful it made me realize i was failing on the 2nd iteration of code because i was doing this:


		VBA Code:
__


If (vRows1(ii, 1)) = "TRUE" Then


when in reality it should be something like this as its already a logical value


		VBA Code:
__


If (vRows1(ii, 1)) Then


----------



## Peter_SSs

Ah, looks like post #51 was forgotten.   😎


----------

