Solved

Copy Column Based on Date Criteria

Posted on 2011-09-19
10
265 Views
Last Modified: 2012-05-12
Hi,

Need some help with some coding in Excel VBA which will do...

I have a Budget sheet, on the master sheet it currently has all the days covered for the next 10 years, i.e. some 3,650 columns which take forever to load!.  Having reviewed what is actually happening only about 8 days a month actually show what is going out, so basically I need to be able to copy the entire column from Column D (which contains all the relevant forulas required) and place it in E, then F and so on as much is required to cover 10 years worth.

It needs to read in a range from =Summary!D8:D27 which contains the days actually used for any transfers to show, but must also include every FRIDAY regardless.  And then change its Row 3 of its own column to reflect the actual date.  The initial start date must come from D3 (Which would contain the day, month and year) to start with.

Then duplicate this method to to show ten years worth of columns and be dynamic so I could change my mind to say 20 yrs!.

Hope that makes sense.

Cheers
0
Comment
Question by:StormFusion
  • 4
  • 4
10 Comments
 
LVL 19

Expert Comment

by:akoster
ID: 36560408
could you post an example file with some data entries, this would greatly aid us...
0
 

Author Comment

by:StormFusion
ID: 36561231
Attached an example, if you go to tab MASTER your see that Column D already contains contents that need to be duplicate E onwards, the day it shows must also be a workday, so bills that may go out on the 1st of the month generally will, unless the day is a holiday or SAT or SUN, in which case it needs to show the next available workday.

Cheers
Example.xlsm
0
 
LVL 19

Expert Comment

by:akoster
ID: 36561314
The column() formula works great when you want all days to be visible. You could opt to hide all unneccesary days/columns but they will still be present and take time to load.

There are two likely options :

 - use the column formulae as they are now to populate the entire worksheet, copy and paste as values (thereby removing the need to recalculate the formula's over and over again) and removing all unneccesary columns. This can either be done by hand or using a macro.

 - generate a list of all dates that you do want to have, and fill the master sheet columns with the chosen dates. This too can be done by hand or by making use of macro code.

If you choose which path you like best, i'll get you through...
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

Author Comment

by:StormFusion
ID: 36561530
Hi,

Option 1 - This would start with a small file, but on open would generate the entire worksheet so on saving filesize would be greater, unless range is oblitered on save?

Option 2 - The list of required dates per month is in the Summary page, but this does not take into account working days or Fridays.

So maybe option 1 is best route?  And kill the range on save.
0
 

Author Comment

by:StormFusion
ID: 36570768
??
0
 
LVL 19

Expert Comment

by:akoster
ID: 36573200
That's worth a shot : you get a small file that can be opened quickly but will 'regenerate' the formulas for the days that you seem fit.

In order to minimize the time needed for the regenerating, step 2 would be a huge advantage. Incorporating working days and fridays is certainly possible because there are formulas for that.

can you try this :
Public Sub regenerate()
Dim dates As Dictionary
Dim date_list() As String
Dim date_day As String, date_month As Integer, date_year As Integer
Dim date_entry As String
Dim x, y
        
    Application.StatusBar = "initialising"
    Set dates = New Dictionary
    start_date = Worksheets("Master").Range("B3")
    
    Application.StatusBar = "adding all given dates"
    For date_year = Year(start_date) To (Year(start_date) + 9)
        For date_month = 1 To 12
            For pos = 1 To 17
                date_day = Worksheets("Summary").Range("D" & pos + 7)
                date_entry = date_day & "-" & date_month & "-" & date_year
                If IsDate(date_entry) Then
                    If Not dates.Exists(date_entry) Then
                        dates.Add date_entry, date_entry
                    End If
                End If
            Next pos
        Next date_month
    Next date_year
    
    Application.StatusBar = "adding all fridays"
    For x = start_date To start_date + 3649
        '-- monday = 1 so friday = 5
        If Weekday(x, vbMonday) = 5 Then
            If Not dates.Exists(x) Then dates.Add x, x
        End If
    Next x
    
    Application.StatusBar = "dictionary to array for easy sorting"
    ReDim date_list(dates.Count - 1)
    For x = 0 To dates.Count - 1
        date_list(x) = dates.Items(x)
    Next x
    
    Application.StatusBar = "sorting"
    xmax = UBound(date_list)
    For x = 0 To xmax
        For y = x + 1 To xmax
            If date_list(y) < date_list(x) Then
                '-- exchange items
                    temp = date_list(x)
                    date_list(x) = date_list(y)
                    date_list(y) = temp
            End If
        Next y
        Application.StatusBar = "sorting : " & CInt(1000 * x / xmax) / 10 & "%"
    Next x
    
    Application.StatusBar = "exporting dates to master sheet"
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For x = 0 To dates.Count - 1
        Worksheets("Master").Cells(3, x + 5) = DateValue(dates.Items(x))
        '-- lookup last column name, strip $ signs
        lastcolumn = Mid(Worksheets("Master").Cells(3, x + 5).Address, 2)
        lastcolumn = Left(lastcolumn, InStr(lastcolumn, "$") - 1)
    Next x
    
    Application.StatusBar = "extending formulas"
    Set src = Worksheets("Master").Range("D5:D27")
    Set dst = Worksheets("Master").Range("D5:" & lastcolumn & "27")
    src.AutoFill Destination:=dst, Type:=xlFillDefault
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    Application.StatusBar = "cleaning up"
    Set src = Nothing
    Set dst = Nothing
    Set dates = Nothing
    
    Application.StatusBar = False

End Sub

Open in new window

0
 

Author Comment

by:StormFusion
ID: 36576766
Hi akoster

Thank you for taking the time with that code, but it seems to stop at the first line Dim dates As Dictionary saying User-defined type not defined.

Im using Excel 2010 btw.

Cheers

Wayne
0
 
LVL 19

Accepted Solution

by:
akoster earned 500 total points
ID: 36579240
sorry, should have included the information that the dictionary object is not standard, in order to use the "microsoft scripting runtime" must be added.
0
 
LVL 50

Expert Comment

by:Ingeborg Hawighorst
ID: 37412245
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvieā€¦
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

816 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

11 Experts available now in Live!

Get 1:1 Help Now