Solved

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

Posted on 2014-03-25
8
291 Views
Last Modified: 2014-03-25
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
Comment
Question by:discogs
  • 4
  • 4
8 Comments
 
LVL 39

Expert Comment

by:nutsch
ID: 39954643
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
 

Author Comment

by:discogs
ID: 39954686
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
 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 39954701
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
 

Author Comment

by:discogs
ID: 39954779
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
Free Gift Card with Acronis Backup Purchase!

Backup any data in any location: local and remote systems, physical and virtual servers, private and public clouds, Macs and PCs, tablets and mobile devices, & more! For limited time only, buy any Acronis backup products and get a FREE Amazon/Best Buy gift card worth up to $200!

 
LVL 39

Assisted Solution

by:nutsch
nutsch earned 500 total points
ID: 39954807
Remove your wkb reference and use this instead;

Set shtF=thisworkbook.sheets("f")

Same thing for shtT
0
 

Author Comment

by:discogs
ID: 39954979
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
 

Author Closing Comment

by:discogs
ID: 39954980
Great help. Thanks
0
 
LVL 39

Expert Comment

by:nutsch
ID: 39954995
Glad to help

Thomaa
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

The System Center Operations Manager 2012, known as SCOM, is a part of the Microsoft system center product that provides the user with infrastructure monitoring and application performance monitoring. SCOM monitors:   Windows or UNIX/LinuxNetwo…
This collection of functions covers all the normal rounding methods of just about any numeric value.
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now