VBA determines order of variable based on value (dates)

deewan

New Member
Joined
Jun 17, 2010
Messages
3
I am working on a macro with two parts. The first part opens some text files which contain sections of 10-12 rows of seasonal data. I have all the data pulled correctly and dates (which vary) which below to that data assigned to variables. The variables are called Season_1_Start_Date, Season_1_Stop_Date, Season_2_Start_Date, Season_2_Stop_Date, and so forth. The variables are assigned in order moving from the top of the text file to the bottom. But in some cases the text file as the most recent date at the bottom, and other times the most recent date is on the top.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
My problem comes in part two of the macro. The macro takes the data which is all assigned to variables and drops it into an excel worksheet. Right now it drops it using Season_1 first, Season_2 second, Season_3 and so forth depending how many seasons there are. But since the date order can vary in the text file, the macro might need to drop the variable data assigned to Season_2 first, then the Season_1, and finally Season_3. <o:p></o:p>
<o:p></o:p>
Is there a way to have VBA determine the chronological order of dates which are stored as variables and have VBA then go through a loop dropping data in an oldest to newest order?<o:p></o:p>
<o:p></o:p>
Hopefully my question makes sense. Thanks in advance for any help. I've been a long time reader here for help, first time poster.<o:p></o:p>
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Well there probably is, but I'm wondering whether it might be necessary.

My first thoughts are to sort the data after it's been dropped, but that may not be easy if the data goes in non-contiguous area of the sheet.

Second thoughts are, since it's a text file, to open it/import it into a temporary sheet, tart it up/sort it, move the data to the final destination sheet, then delete the temporary sheet.

It'd be useful to see some code, some sheets too and a sample of the text file. (Perhaps you can zip these up and post them on the web somewhere)
 
Upvote 0
Thanks for the response. The thought had crossed my mind to try to sort the data on the side before dropping it into the table. My code is listed below but it really isn't that helpful without seeing the text file. And for the life of my I can't find a way to attach the text file to this thread.

Here is the code I have so far.
Code:
'***************************** BEGIN OF GATHERING METER BILLING DATA ********************************
'Open .TOU file
     Workbooks.Open Filename:= _
        "C:\MyDocs\Current Projects\Electronic Validation\New Validations\" & Totalizer_ID & ".TOU", _
        Origin:=xlWindows
'Error might occur if there are not 3 Seasons on the validations.  If error happens, skip the "find" functions
'which are used to find the season splits.
On Error GoTo cleanup
Range("A1").Select
'***************** SEASON 1 ********************
'Find First Season.
Do Until ActiveCell.Offset(0, 1).Value = "#" And ActiveCell.Offset(0, 2).Value <> Validation_num
'Serach for Season 1.  This Channel has all the billing data
Cells.Find(What:="Season", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    'Remove "Channel#" so the macro does not find that value again during another search
    ActiveCell.Clear
Loop
'Assign this seasons dates
Validation_num = ActiveCell.Offset(0, 2).Value
Num_of_Periods = Num_of_Periods + 1
'Perform a check to determine if the dates are locationed 5, 6, 7, or 8 columns to the right based on
'if this is a "new" season.
If ActiveCell.Offset(0, 4) = "FROM" Then
c = 0
Else
c = 1
End If
Season_1_Start_Date = Format(ActiveCell.Offset(0, 5 + c), "mmdd")
Season_1_Stop_Date = Format(ActiveCell.Offset(0, 7 + c), "mmdd")
Range("A1").Select
Do Until ActiveCell.Offset(0, 1).Value = "1"
'Search for Channel #1.  This Channel has all the billing data
Cells.Find(What:="Channel#", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    'Remove "Channel#" so the macro does not find that value again during another search
    ActiveCell.Clear
Loop
ActiveCell.Offset(1, 3).Select
'Assign variables from data validation
season_1_kw_onpeak_reading = ActiveCell.Offset(1, 2).Value
season_1_power_factor_onpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -2).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_1_kwh_onpeak_reading = ActiveCell.Offset(0, -1).Value
'Move down by row until "KVA" is found for Offpeak data
    Do Until ActiveCell.Value = "KVA"
    'Clear out any other Channel labels on the way down
        If ActiveCell.Offset(0, -3).Value = "CHANNEL#" Then
        ActiveCell.Offset(0, -3).Clear
        End If
    ActiveCell.Offset(1, 0).Select
    Loop
season_1_kw_offpeak_reading = ActiveCell.Offset(1, 2).Value
season_1_power_factor_offpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -1).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_1_kwh_offpeak_reading = ActiveCell.Value
'***************** SEASON 2 ********************
'Find Season 2.  Make sure the season found is season 1
Do Until ActiveCell.Offset(0, 1).Value = "#" And ActiveCell.Offset(0, 2).Value <> Validation_num
'Serach for Season 1.  This Channel has all the billing data
Cells.Find(What:="Season", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    'Remove "Channel#" so the macro does not find that value again during another search
    ActiveCell.Clear
Loop
'Assign this seasons dates
Validation_num = ActiveCell.Offset(0, 2).Value
Num_of_Periods = Num_of_Periods + 1
'Perform a check to determine if the dates are locationed 5, 6, 7, or 8 columns to the right based on
'if this is a "new" season.
If ActiveCell.Offset(0, 4) = "FROM" Then
c = 0
Else
c = 1
End If
Season_2_Start_Date = Format(ActiveCell.Offset(0, 5 + c), "mmdd")
Season_2_Stop_Date = Format(ActiveCell.Offset(0, 7 + c), "mmdd")
'Find Season 2 Billing Data
Do Until ActiveCell.Offset(0, 1).Value = "1"
Cells.Find(What:="Channel#", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Clear
Loop
ActiveCell.Offset(1, 3).Select
'Move down each row until "KVA" is found for Onpeak data
    Do Until ActiveCell.Value = "KVA"
    ActiveCell.Offset(1, 0).Select
    Loop
'Assign variables from data validation
season_2_kw_onpeak_reading = ActiveCell.Offset(1, 2).Value
season_2_power_factor_onpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -2).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_2_kwh_onpeak_reading = ActiveCell.Offset(0, -1).Value
'Move down each row until "KVA" is found for Offpeak data
    Do Until ActiveCell.Value = "KVA"
    ActiveCell.Offset(1, 0).Select
    Loop
season_2_kw_offpeak_reading = ActiveCell.Offset(1, 2).Value
season_2_power_factor_offpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -1).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_2_kwh_offpeak_reading = ActiveCell.Value
'***************** SEASON 3 ********************
'Find Season 3.  Make sure the season found is season 3
Do Until ActiveCell.Offset(0, 1).Value = "#" And ActiveCell.Offset(0, 2).Value <> Validation_num
'Serach for Season 1.  This Channel has all the billing data
Cells.Find(What:="Season", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    'Remove "Channel#" so the macro does not find that value again during another search
    ActiveCell.Clear
Loop
'Assign this seasons dates
Validation_num = ActiveCell.Offset(0, 2).Value
Num_of_Periods = Num_of_Periods + 1
'Perform a check to determine if the dates are locationed 5, 6, 7, or 8 columns to the right based on
'if this is a "new" season.
If ActiveCell.Offset(0, 4) = "FROM" Then
c = 0
Else
c = 1
End If
Season_3_Start_Date = Format(ActiveCell.Offset(0, 5 + c), "mmdd")
Season_3_Stop_Date = Format(ActiveCell.Offset(0, 7 + c), "mmdd")
'Find Season 3 Billing Data
Do Until ActiveCell.Offset(0, 1).Value = "1"
Cells.Find(What:="Channel#", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
ActiveCell.Clear
Loop
ActiveCell.Offset(1, 3).Select
'Move down each row until "KVA" is found for Onpeak data
    Do Until ActiveCell.Value = "KVA"
    ActiveCell.Offset(1, 0).Select
    Loop
'Assign variables from data validation
season_3_kw_onpeak_reading = ActiveCell.Offset(1, 2).Value
season_3_power_factor_onpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -2).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_3_kwh_onpeak_reading = ActiveCell.Offset(0, -1).Value
'Move down each row until "KVA" is found for Offpeak data
    Do Until ActiveCell.Value = "KVA"
    ActiveCell.Offset(1, 0).Select
    Loop
season_3_kw_offpeak_reading = ActiveCell.Offset(1, 2).Value
season_3_power_factor_offpeak = ActiveCell.Offset(1, 5).Value
    Do Until ActiveCell.Offset(0, -1).Value = "KWH:"
    ActiveCell.Offset(1, 0).Select
    Loop
    season_3_kwh_offpeak_reading = ActiveCell.Value
'******************************* END OF GATHERING METER BILLING DATA ********************************
'Resume here if an error occurs when searching for season splits
here:
'Close .TOU File
ActiveWindow.Close False
'Select employees private worksheet to paste billing data into
Windows(MacroWorkbook).Activate
    'If this is an AEP customer, store informaiton on Keymaster worksheet.  All customers billed using LGS/CMS
    'will be put on the LGS worksheet.
    If Left(Billing_ID, 3) = "AEP" Then
    Sheets("Keymaster").Select
    Else
    Sheets("LGS").Select
    End If
    Range("B1").Select
    Do Until ActiveCell.Value = "" Or ActiveCell.Value = Billing_ID
    ActiveCell.Offset(19, 0).Select
    Loop
'Paste billing data into spreadsheet
ActiveCell.Value = Billing_ID
ActiveCell.Offset(1, 0).Value = Num_of_Periods
'* * * Calculate Pulse Percentage * * *
pulse_percentage = (KWH_Total - (season_1_kwh_onpeak_reading + season_2_kwh_onpeak_reading + season_3_kwh_onpeak_reading)) / (season_1_kwh_offpeak_reading + season_2_kwh_offpeak_reading + season_3_kwh_offpeak_reading)
ActiveCell.Offset(2, 0).Value = Meter_Start_read
ActiveCell.Offset(3, 0).Value = Meter_stop_read
 
ActiveCell.Offset(8, 0).Value = KWH_Total
'Enter Period 1 Meter Data
ActiveCell.Offset(4, 0).Value = Start_date
ActiveCell.Offset(5, 0).Value = Application.Min(Stop_date, Season_1_Stop_Date)
ActiveCell.Offset(6, 0).Value = season_1_kw_onpeak_reading
ActiveCell.Offset(7, 0).Value = season_1_kw_offpeak_reading
ActiveCell.Offset(8, 0).Value = Round(season_1_kwh_onpeak_reading, 0)
ActiveCell.Offset(9, 0).Value = Round(pulse_percentage * season_1_kwh_offpeak_reading, 0)
ActiveCell.Offset(10, 0).Value = season_1_power_factor_onpeak * 100
ActiveCell.Offset(11, 0).Value = season_1_power_factor_offpeak * 100
If Num_of_Periods > 1 Then
'Enter Period 2 Billing Data
ActiveCell.Offset(4, 1).Value = ActiveCell.Offset(5, 0).Value
ActiveCell.Offset(5, 1).Value = Application.Min(Stop_date, Season_2_Stop_Date & Right(Stop_date, 2))
ActiveCell.Offset(6, 1).Value = season_2_kw_onpeak_reading
ActiveCell.Offset(7, 1).Value = season_2_kw_offpeak_reading
ActiveCell.Offset(8, 1).Value = Round(season_2_kwh_onpeak_reading, 0)
ActiveCell.Offset(9, 1).Value = Round(pulse_percentage * season_2_kwh_offpeak_reading, 0)
ActiveCell.Offset(10, 1).Value = season_2_power_factor_onpeak * 100
ActiveCell.Offset(11, 1).Value = season_2_power_factor_offpeak * 100
End If
If Num_of_Periods > 2 Then
'Enter Period 3 Billing Data
ActiveCell.Offset(4, 2).Value = ActiveCell.Offset(5, 1).Value
ActiveCell.Offset(5, 2).Value = Application.Min(Stop_date, Season_3_Stop_Date & Right(Stop_date, 2))
ActiveCell.Offset(6, 2).Value = season_3_kw_onpeak_reading
ActiveCell.Offset(7, 2).Value = season_3_kw_offpeak_reading
ActiveCell.Offset(8, 2).Value = Round(season_3_kwh_onpeak_reading, 0)
ActiveCell.Offset(9, 2).Value = Round(pulse_percentage * season_3_kwh_offpeak_reading, 0)
ActiveCell.Offset(10, 2).Value = season_3_power_factor_onpeak * 100
ActiveCell.Offset(11, 2).Value = season_3_power_factor_offpeak * 100
End If
'Error handler if season splits are not found.
Exit Sub
cleanup:
    Resume here
End Sub
 
Upvote 0
Again, thanks for the input and help. I am currently writing code to do a temp drop then sort the dates there before going into the formatted table. If I ever do find a way, I'll make sure I post back to this thread.
 
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,733
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top