• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 302
  • Last Modified:

VBA Transfer User Defined Data Set from Sheet A to Sheet B

Hi,

The enclosed file contains a sheet (f) that contains 9 columns of data (a through i). The data is dynamic and will continuously grow over time to thousands of records.

My requirement needs to consider user input of 1. From Date (in cell L2) and 2. To Date (in cell L3). The data I want to extract from sheet f should only contain all records that meet the above criteria, AND, only where column(i) has a value of > 0.

Once obtaining the data set, I want to be able to transfer the data into a prescribe range on another sheet. In the enclosed example, it is sheet t and the range I want to place the data is from a21.

Now I realise there are probably multiple ways of doing this, however, I wanted to get some assistance in creating a dynamic array (using a loop, LBound and UBound) or something similar for my own knowledge.

Sample file enclosed.

Any help appreciated.
TA
Sample.xlsx
0
discogs
Asked:
discogs
  • 4
  • 4
2 Solutions
 
nutschCommented:
Here's what I have, with an autofilter and specialcells

Sub Macro2()
Dim shtF As Worksheet, shtT As Worksheet
Dim lNumRows As Long


'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


Set shtF = Sheets("f")
Set shtT = Sheets("t")

With shtF.[a1].CurrentRegion
    .AutoFilter
    .AutoFilter Field:=2, Criteria1:= _
        ">=" & Format(shtF.[l2], "mm/dd/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(shtF.[l3], "mm/dd/yyyy")
    
    lNumRows = Application.WorksheetFunction.Subtotal(3, shtF.Columns(1))
    
    If lNumRows >= 15 Then
        shtT.Rows("19:" & lNumRows + 3).Insert
    Else
        shtT.Rows(lNumRows + 4 & ":18").EntireRow.Delete
    End If
    
    .SpecialCells(xlCellTypeVisible).Copy shtT.Cells(4, 1)
    .AutoFilter
    
End With


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Open in new window


Thomas
0
 
discogsAuthor Commented:
Hey Thomas

Thanks for your reply to my question.
I have tested your code and enclose the following for your further consideration:

1. When I execute, it populates the data from row 4 with the headers. I specifically wanted the raw data to be placed from cell a21 of sheet t;
2. The retrieved data from sheet t contains all the values in that date range. It does not take into account cells with 0 or blank. In the sample I provided, there should of been only one row of data returned. It was Cheque 7 with a value of 1,453.13.
3. The solution your provided does not take into account the "Application.ThisWorkbook.FullName" method. So as to say, if I had 2 workbooks open at the same time, the code would fall over. Am I correct?
4. Lets say I had a dynamic range name for the source data in tab f. Lets call it [data] for the sake of applying a name. Is it possible to refer to that name in the code you provided?

Thanks Thomas.

TA
0
 
nutschCommented:
Some changes then:

3. It would refer to the activeworkbook, you can specify whichever workbook you want when setting shtf and shtt variables
4. instead of shtF.[a1].CurrentRegion,  you could use shtf.range("data")

Sub Macro2()
Dim shtF As Worksheet, shtT As Worksheet
Dim lNumRows As Long


'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


Set shtF = Sheets("f")
Set shtT = Sheets("t")

With shtF.[a1].CurrentRegion
    .AutoFilter
    .AutoFilter field:=2, Criteria1:= _
        ">=" & Format(shtF.[l2], "mm/dd/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(shtF.[l3], "mm/dd/yyyy")
    .AutoFilter field:=9, Criteria1:="<>"
    
    
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy shtT.Cells(21, 1)
    .AutoFilter
    
End With


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Open in new window

0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
discogsAuthor Commented:
Hi Thomas,

Thanks for this.

Looks and runs good.

Only thing is the Application.ThisWorkbook.FullName. I ham having an issue with migrating it into your sample code. If you could provide guidance on line 18 that would be great. Then we can close this off.

Sub Macro2()
Dim shtF As Worksheet, shtT As Worksheet
Dim lNumRows As Long
Dim wkb As String

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

wkb = Application.ThisWorkbook.FullName
Set shtF = Sheets("f")
Set shtT = Sheets("t")

With (wkb).(shtF).[a1].CurrentRegion
    .AutoFilter
    .AutoFilter field:=2, Criteria1:= _
        ">=" & Format(shtF.[l2], "mm/dd/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(shtF.[l3], "mm/dd/yyyy")
    .AutoFilter field:=9, Criteria1:="<>"
    
    
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy shtT.Cells(21, 1)
    .AutoFilter
    
End With


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Open in new window


TA
0
 
nutschCommented:
Remove your wkb reference and use this instead;

Set shtF=thisworkbook.sheets("f")

Same thing for shtT
0
 
discogsAuthor Commented:
Sorry Thomas. Had a unexpected meeting.

This works a treat champ. Well done.

I have managed to get everything I wanted resolved.

All the best.
TA
0
 
discogsAuthor Commented:
Great help. Thanks
0
 
nutschCommented:
Glad to help

Thomaa
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now