Resize Array based on date value
Resize Array based on date value
Resize Array based on date value
Resize Array based on date value
Resize Array based on date value
Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value
Resize Array based on date value Resize Array based on date value
Resize Array based on date value
Go Back  Xtreme Visual Basic Talk > > > > Resize Array based on date value


Reply
 
Thread Tools Display Modes
  #1  
Old 03-07-2017, 02:24 PM
cacody cacody is offline
Junior Contributor
 
Join Date: Apr 2011
Location: Scottsdale AZ
Posts: 323
Default Resize Array based on date value


A couple of years ago Passel provided me with this code that parses rows from a variant array based on a string value. This is a range to array and back to range subprocedure.

Code:
Sub Macro2()
'From passel
Dim NextRow As Integer
Dim Rng() As Variant
'
Application.ScreenUpdating = False
starttime = Timer
Application.Calculation = xlCalculationManual

'reads the range to the variant array
Rng = Range("A1:D" & ActiveSheet.UsedRange.Rows.Count).Value
NextRow = Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("F:F")) + 1
Set Destination = Sheets("Sheet1").Range("F" & NextRow)
Dim aPtr As Integer
aPtr = 1  'point to the beginning of the array, we'll start packing data as we find it here.

'sectrval = [m3]
sectrval = "Energy"
sectrval2 = "Consumer Staples"
For r = 1 To UBound(Rng, 1)
    If Rng(r, 3) = sectrval Or Rng(r, 3) = sectrval2 Then    'sectrval in column 3
        For c = 1 To UBound(Rng, 2)
            Rng(aPtr, c) = Rng(r, c)
        Next c
        aPtr = aPtr + 1
    End If
Next r
Destination.Resize(aPtr - 1, UBound(Rng, 2)).Value = Rng

Columns("F:I").AutoFit
Range("A1").Select
Application.ScreenUpdating = True

endtime = Timer
Application.Calculation = xlCalculationAutomatic

MsgBox Format(endtime - starttime, "0.000000" & " secs")

End Sub
I put a timer on it because I was testing the use of filters, loops, and arrays for relative speed.

I changed the code above to search on date in column 1 instead of a string value in column 3. The resulting range needs to be only those rows of data with a date equal or greater than the assigned date (ChkDte). Also - and important - I need to retain formulas, so changed the "Value" to "Formula" at the range.

Code:
Sub Macro2()
'From passel
Dim NextRow As Integer
Dim Rng() As Variant, ChkDte As String, c As Long
'
Application.ScreenUpdating = False
starttime = Timer
Application.Calculation = xlCalculationManual

'reads the range to the variant array
Rng = Range("A1:D" & ActiveSheet.UsedRange.Rows.Count).Formula
NextRow = Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("F:F")) + 1
Set Destination = Sheets("Sheet1").Range("F" & NextRow)
Dim aPtr As Integer
aPtr = 1  'point to the beginning of the array, we'll start packing data as we find it here.

'sectrval = [m3]
ChkDte = [M1]    'This is a date value
For r = 1 To UBound(Rng, 1)
    If Rng(r, 1) >= ChkDte Then     'date value in column 1
        For c = 1 To UBound(Rng, 2)
            Rng(aPtr, c) = Rng(r, c)
        Next c
        aPtr = aPtr + 1
    End If
Next r
Destination.Resize(aPtr - 1, UBound(Rng, 2)).Formula = Rng

Columns("F:I").AutoFit
Range("A1").Select
Application.ScreenUpdating = True

endtime = Timer
Application.Calculation = xlCalculationAutomatic

MsgBox Format(endtime - starttime, "0.000000" & " secs")

End Sub
Unfortunately, when I use a date value it doesn't work. I tried to dim ChkDte as Date, and String. I get the full range returned, but the good news is the formulas are retained. Not sure what I'm doing wrong. Need another set of eyes on this. Thanks.
Reply With Quote
  #2  
Old 03-08-2017, 09:21 AM
MPiResize Array based on date value MPi is offline
Senior Contributor

Forum Leader
* Expert *
 
Join Date: Dec 2001
Location: Quebec
Posts: 1,000
Default

ChkDte has to be declared As Date since you're comparing with ">="
And make sure the dates (cells format) in your column A are real dates and not Text.
__________________
MPi²
Reply With Quote
Reply

Tags
aptr, date, dim, array, range, uboundrng, rng, nextrow, timer, rngr, sectrval, chkdte, variant, column, starttime, integer, application.calculation, string, data, set, passel, true, rangea1.select, endtime, formatendtime


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
Resize Array based on date value
Resize Array based on date value
Resize Array based on date value Resize Array based on date value
Resize Array based on date value
Resize Array based on date value
Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value Resize Array based on date value
Resize Array based on date value
Resize Array based on date value
 
Resize Array based on date value
Resize Array based on date value
 
-->