VBA Code to fill over data values (moving midnight)

[GoldLama]

Hi all,

I'm building a spreadsheet to help deal with an issue at work around train stock. Unfortunately, we don't stop running trains at midnight, and many of these instances mean i'm dealing with times that bridge midnight.

I have come up with a solution to this (which has effectively moved midnight to 03:00), however my VBA code that fixes the errors this applies is a series of copies and pastes. I would like to have a formula that reads down the time column, and where the time is less than 03:00, it adds 1 to the time (i.e.: moving it to the next day so that it considers 03:00 the end of the day rather early in the day).

Basically I have columns in a table named ONATime (D9:D109) and RESTime (G9:G109)

I then have a separate column that applies the formula =if(or($D9=0,$d9=""),"",if($D9=<0.125, $D9+1, $D9))

That column is then copied and pasted by the Macro as values

That NEW column is then copied and pasted over the original D9:D109 column to exclude blank values

What I would like instead is a macro that simply applied that formula to columns D9:109 + G9:G109 and replaced any data in that column with the results of the formula, excluding blanks

Is there a way to do this? I mean right now it works, but it just seems inelegant and it could be done more cleanly.

Thanks,

Tom

 

[sijpie]

Option Explicit

Sub AdjustDate()
'=if(or($D9=0,$d9=""),"",if($D9=<0.125, $D9+1, $D9))
    Dim vT As Variant
    Dim lR As Long, i As Integer
    
    For i = 4 To 7 Step 3   'apply to columns 4 (D) and 7 (G)
        'copy column into array for fast processing
        vT = Cells(9, i).Resize(100, 1).Value
        
        For lR = 1 To UBound(vT, 1)
            ' for each cel in array check if 0 or smaller than 3:00
            Select Case vT(lR, 1)
                Case 0
                    vT(lR, 1) = ""
                Case Is <= 0.125
                    vT(lR, 1) = vT(lR, 1) + 1
            End Select
        Next lR
        
        'now write array back to sheet
        Cells(9, i).Resize(100, 1).Value = vT
    Next i
    
End Sub

Blink and you will miss it...

 

[GoldLama]

Thanks! That worked, although I admit I don't quite understand why :O

the copying into an array for fast processing - what is this? how does it work?

 

[sijpie]

See an array as a virtual spreadsheet. For some reason working with the 'cells' in an array is very much faster than working with the cells in a spreadsheet. Particularly write operations in a sheet are very slow.
So if i set a variable (of type variant) to an area in a spreadsheet, the contents of that area are read into the variable as an array, in one read operation. i can then do my calculations, checking etc in the array, and when done write back the array to the spreadsheet in one write operation.

So in your code the range D9:D109 is read into the variable vT:

vT = Cells(9, i).Resize(100, 1).Value

In the first run i = 4, so Cells(9,i) is D9. This is resized with 100 rows and 1 column, so becomes D9:D109
In the second run i is increased by 3 (from i=4 to 7 step 3), and so the range read into vT becomes G9:G109

If you would then look at vT, it would consist of 100 cells in one column. You can address each cell: vt(row,1)
so the code steps through each of the cells with the loop:

For lR = 1 To UBound(vT, 1)
            ' for each cell in array check if 0 or smaller than 3:00
            .... do stuff
        Next lR

UBound(array,1) returns the number of rows in the array
Ubound(array,2) would return the number of columns

It is always good practice to use the UBound() function and not rely on a number (I could have hard coded 'From 1 to 100') . What would happen if you decided that the range was going to be different size? then you would have to check all your hard coded limits.

The other thing to know is (very useful) is that when you set a variant to a range like this, the cells in the array run from row 1 to x and column 1 to y.
On the other hand if i define an array from scratch, I will have to specify the starting number, else it will be 0:

Dim vArr1(1 to 100, 1 to 5) as variant
Dim vArr2(100, 5) as variant

vArr1(1, 1) = "First cell of Array1"
vArr2(0, 0) = "First cell of Array2"

Read up on arrays, they are very useful. I think I have added more information on them in my guide to better coding, see link below.

 

[GoldLama]

@sijpie thank you - i've been playing around with it and I can see how it's working now, and it's really good. The application of formula that quickly is good cause a) it's less columns to get corrupted by others copying+pasting what they shouldn't, and b) the sheet is faster. Which overall is good because while it was running on 100 lines it was good, but now i'm in the position of having to extend the sheet to 1000 lines because of how bad cancellations are getting.

Which leads me to the next point - there's one more part of my macro that is still a copy-paste. I have the whole sheet on A1:Z:110, and i've replicated the sheet (including locked/protected cells) on aa1:az110. The macro copies this range and pastes the formatting each time the macro runs so that if others copy and paste from emails into the sheet it doesn't screw up the layout.

How easy is it to write VBA to draw outlines and set fonts/size/formatting etc.

Essentially my table currently runs from D7:L110 (including headers) and has a stock calculator above it from D2:L5, as well as a time selector p2:q5 and a snap shot display p7:q7 and auto-fills down depending on how many trains are cancelled at each time selected.

I would like to write VBA so that instead of copying/pasting the formatting each time this macro runs it clears the formatting and reapplies it across the whole spreadsheet so that it's unable to be corrupted by accidental copy/paste or from another workbook with some hidden gremlin. Do you have any pointers?

Mostly the the formatting consists of standard cells with borders drawn, some of which have thick borders, and two columns have slightly different fill. I've had a look at the fill/font/centre align text all seems relatively straight forward and it works relatively easily since most of it can be done by large range selections. But is there a way to do it that is better? Or is it just a matter of writing out each range and putting in the relevant setting using the range.("A1:Z110")?

Thanks,

Tom

 

[sijpie]

I can't see a great time consuming issue in copy pasting the format once.
An alternative would be to restore the required formatting immediately with any change a user makes. To do this have a hidden sheet with the same formatting as the main sheet, just empty of data.

Then in the code module of the main sheet (right click on the sheet tab, view code) open the worksheet_change() sub.

Here the following code would apply the required format to any changed range (cell or copied area):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'Restore the required format to any changed area
    
    ' a (hidden) sheet 'ReqFormat' has the format identical to this main sheet
    Dim rFormat As Range
    
    With Sheets("ReqFormat")        '<<<< see commment above
        Set rFormat = .Range(Target.Address)
    End With
    
    'copy the required format for the area
    rFormat.Copy
    'paste format into the changed area
    Target.PasteSpecial xlPasteFormats
    
    Set rFormat = Null
End Sub

 

[GoldLama]

@sijpie so thank you again for all the advice you've given. I've been working on the sheet and it is now a very versatile tool, but i've come across a new issue, and frankly how to code it in VBA is just beyond me.

The issue we have is that previously we only ever had trains running from 04:45 in the morning until 01:30 at night. I had chosen 03:00 as the time to check until, because traditionally the 'traffic day' has run until 0300 in the morning (despite all trains being stabled by 0130 ordinarily). So right now my formula checks for any time values that are below 0.125, and if they are below that point, adds a 1, and it has worked perfectly.

However, now two nights/week we run trains all night, yet we still have to cope with the issue of the traffic day changing at 0300. The best solution I have to this is to identify which duties on the days that we run all night (Friday + Saturday) and have the sheet user input an additional bit of information to mark that duty as a 'night turn'. The intention is that if a train cancellation or re-entry time is below 0.125, still add the one, except if it is a night turn. If it is a night turn and the duty day matches the traffic day, and the time is below 0830 (using 0.36 in this case), to add a 1 to that, otherwise remain as is.

For example:

If it is Saturday night (which is traffic day Saturday from 0300 Saturday until 0300 Sunday), Train 5 is being driven by Friday night turn duty 490, and is cancelled from 01:30 until 04:30, then I don't want the formula to add a 1 to those figures.

However, if the duty turn matches the traffic day (so it's Saturday night and 490 is a Saturday night turn), then all times below 0.36 need to have a 1 added to them.

Currently, the VBA i'm using is this:

'=if(or($f9=0,$f9=""),"",if($f9=<0.125, $f9+1, $f9))
Dim vT As Variant
Dim lR As Long, i As Integer

For i = 6 To 8 Step 2 'apply to columns 6 (f) and 8 (h)
'copy column into array for fast processing
vT = Cells(9, i).Resize(1000, 1).Value

For lR = 1 To UBound(vT, 1)
' for each cell in array check if 0 or smaller than 3:00, if it is then +1
Select Case vT(lR, 1)
Case 0
vT(lR, 1) = ""
Case Is <= 0.125
vT(lR, 1) = vT(lR, 1) + 1
End Select
Next lR

'now write array back to sheet
Cells(9, i).Resize(1000, 1).Value = vT
Next i

So i need to add a few things to this code:

First before manipulating the times in column f and h, check if they are night turns. If they are not, then proceed as the formula currently does
The identifier for this will be in column C - if Column C = "FRIDAY NT ONA" or "SATURDAY NT ONA" then it is a night turn (otherwise, all the other reasons for cancellation will be ONA, NOOK, DIS, DID, STOCK BALANCE, SERVICE DISRUPTION, STOCK MOVE, or even blank - for all other options than the two NT options, they are non night turn duties.

As I only dimly understand how this code works, I'm guessing this would all be done with various Case modifiers; however how that actually concretely works is a bit beyond me.

If they are night turns, and the night turn duty is for the previous traffic day, do not modify the times at all (even below 0.125)

If they are night turns, and the night turn duty is for the current traffic day, add 1 to the times that are below 0.36

other bits that might help - i have a named range called 'trafficday' (l5:m5 of the main sheet) which is a text output from =TEXT(IF((NOW()-TODAY())<0.125,(TODAY()-1),TODAY()),"dddd")
I also have a column that reads off the FRIDAY NT ONA or SATURDAY NT ONA and spits out Friday or Saturday in 'Data'!EB3:EB1003

The only other thing that I could think would be helpful would be if someone has mistakenly marked one duty as night turn when it is actually a normal duty, it would be good if this same macro would rectify this. Which would essentially mean any figure of greater than 1.125 needs to return only the decimal part of the number. This will also be helpful when the traffic day switches at 0300 in the morning, and those night turn duties that were originally from the current traffic day switch to being night turn duties from the previous traffic day.

Thanks,

Tom

 

[sijpie]

I'll see if i can work on it this week