Solved

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

Posted on 2014-03-25
8
293 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
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 

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

The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
This collection of functions covers all the normal rounding methods of just about any numeric value.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

785 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