VBA Solution to do a -4:00 hour GMT time calculate on imported Data in two Colums for all imported rows

S

smd747

Board Regular
Joined
Apr 24, 2011
Messages
214
The code below imports and formats my data. What I need to do is the values in the following Columns need I need to add a calculation to adjust for GMT Time -4 currently.
The column with the original Arrival Time Date is Q imported to the I column
The column with the original Departure Time Date is T imported to the J column.
Do I need to create a Loop to recalculate ? I attempted to
Code: 
Range("I" & Row).Value = .Range("Q" & i).Value - 4
            Range("J" & Row).Value = .Range("T" & i).Value  -4

From both sides but it did not work.

Here is all my code that works but does not calculate the GMT -4

Code: 
Option Explicit

Sub FormatCustomerDeliveryData()

Dim i                   As Long
Dim j                   As Long
Dim D                   As Long
Dim Row                 As Long
Dim StartRow            As Long
Dim LastRow             As Long
Dim FinalRow            As Long
Dim cell                As Range
Dim Highlight           As Boolean
Dim Prompt              As String
Dim Path                As String
Dim Data()              As String
Dim StartTime           As Date
Dim start_dt            As Date
Dim end_dt              As Date
Dim WkbData             As Workbook
Dim WSReport            As Worksheet

    Prompt = "Select the file to process."
    Path = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , Prompt)
    If Path = "False" Then
        GoTo ExitSub:
    End If

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Set WkbData = Workbooks.Open(Filename:=Path, ReadOnly:=True)
    Workbooks.Add (1)
    
    ' Set Up Colunm Headers
    
     ActiveSheet.Name = "Customer Deliveries Report"
    Range("A1").Value = "Route Date"
    Range("B1").Value = "Vehicle Description"
    Range("C1").Value = "Order No"
    Range("D1").Value = "Stop No"
    Range("E1").Value = "Customer"
    Range("F1").Value = "Town"
    Range("G1").Value = "Zip Code"
    Range("H1").Value = "Driver"
    Range("I1").Value = "Arrival"
    Range("J1").Value = "Departure"
    Range("L1").Value = "Distance"
    Range("K1").Value = "Stop Duration"
    Range("M1").Value = "TWI Open Time"
    Range("N1").Value = "TWI Close Time"
        
    'Format Row Headers
    
    Range("A1").EntireRow.HorizontalAlignment = xlCenter
    Range("A1").EntireRow.VerticalAlignment = xlCenter
    Range("A1").EntireRow.Font.Bold = True
    Range("A1").EntireRow.WrapText = True
    Cells.Font.Name = "Arial"
    Cells.Font.Size = 8
    
    Range("A:A").EntireColumn.ColumnWidth = 10
    Range("B:B").EntireColumn.ColumnWidth = 20
    Range("C:C").EntireColumn.ColumnWidth = 12
    Range("D:D").EntireColumn.ColumnWidth = 10
    Range("E:E").EntireColumn.ColumnWidth = 36
    Range("F:F").EntireColumn.ColumnWidth = 16
    Range("G:G").EntireColumn.ColumnWidth = 10
    Range("H:H").EntireColumn.ColumnWidth = 25
    Range("I:I").EntireColumn.ColumnWidth = 14
    Range("J:J").EntireColumn.ColumnWidth = 14
    Range("K:K").EntireColumn.ColumnWidth = 14
    Range("L:L").EntireColumn.ColumnWidth = 16
    Range("M:M").EntireColumn.ColumnWidth = 14
    Range("N:N").EntireColumn.ColumnWidth = 14
    
    

''''''''''''''''''''''''''''    'Format Colunms

    Range("I:J").NumberFormat = "h\:mm AM/PM"
    Range("L:L").NumberFormat = "0.00"
    Range("M:N").NumberFormat = "h\:mm AM/PM"
    Range("K:K").NumberFormat = "[h]:mm"
    
    
    Range("A1:N1").Interior.Color = RGB(141, 180, 226)
        
    Call AddBorders(Range("A1:n1"))
    
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.DisplayGridlines = True
    
'*************************************************************
            
    With WkbData.Sheets(1)
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row


        FrmProgress.TextBoxProgress.Width = 0
        FrmProgress.LabelPrompt.Caption = "Processing Data: "
        FrmProgress.LabelTimeRemaining.Caption = "Time Remaining: Calculating"
        FrmProgress.TextBoxDummy.SetFocus
        FrmProgress.Show vbModeless
        DoEvents
''''''''''''
        Row = 1
        StartRow = Row
        StartTime = Now
        For i = 4 To LastRow
            FrmProgress.TextBoxProgress.Width = (i / LastRow) * 200
            FrmProgress.LabelPrompt.Caption = "Processing Data: " & i & " of " & LastRow
            FrmProgress.LabelTimeRemaining.Caption = "Time Remaining: " & IIf(i < 50, "Calculating", Format(((Now - StartTime) / i) * LastRow - (Now - StartTime), "h:mm:ss"))
            DoEvents
                Row = Row + 1
' FIRST RANGE SHEET BEING IMPORTED TO, 2ND RANGE EXPORTED FROM
            Range("A" & Row).Value = .Range("A" & i).Value
            Range("B" & Row).Value = .Range("B" & i).Value
            Range("C" & Row).Value = .Range("D" & i).Value
            Range("D" & Row).Value = .Range("E" & i).Value
            Range("E" & Row).Value = .Range("F" & i).Value
            Range("F" & Row).Value = .Range("J" & i).Value
            Range("G" & Row).Value = .Range("L" & i).Value
            Range("H" & Row).Value = .Range("N" & i).Value
            Range("I" & Row).Value = .Range("Q" & i).Value  ''***Need to take this value and adjust to GMT Time -4  (4:00 formatted [H]:MM)
            Range("J" & Row).Value = .Range("T" & i).Value  ''***Need to take this value and adjust to GMT Time -4  (4:00 formatted [H]:MM)  
            Range("L" & Row).Value = .Range("W" & i).Value
            Range("M" & Row).Value = .Range("AB" & i).Value
            Range("N" & Row).Value = .Range("AC" & i).Value

            ' Range K is a calculated field

        Next i
    End With
    
    '*Close Imported Data WorkBook
    
    WkbData.Close SaveChanges:=False
    
    'Continue Cleaning Up
    
'    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' For i = 2 To FinalRow
'            Data = Split(Replace(Range("A" & i).Value, "]", "", , , vbTextCompare), "[", , vbTextCompare)
'            Range("A" & i).Value = Trim(Data(0))
'            Range("B" & i).Value = Trim(Data(1))
'        Next i
'
'  For i = 2 To FinalRow
'            Data = Split(Replace(Range("C" & i).Value, "]", "", , , vbTextCompare), "[", , vbTextCompare)
'            Range("C" & i).Value = Trim(Data(0))
'            Range("D" & i).Value = Trim(Data(1))
'        Next i
'
        

    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    On Error Resume Next


Cells(2, 11).Select
Do
    If IsEmpty(ActiveCell) Then
        If IsEmpty(ActiveCell.Offset(0, -1)) Then
            ActiveCell.Value = ""
        Else
            ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"

ActiveCell.Value = ActiveCell.Value
        End If
    End If
    ActiveCell.Offset(1, 0).Select
    Loop Until IsEmpty(ActiveCell.Offset(0, -1))

Cells(2, 11).Select

    Range("A:A").EntireColumn.HorizontalAlignment = xlCenter
    Range("C:D").EntireColumn.HorizontalAlignment = xlCenter
    Range("G:G").EntireColumn.HorizontalAlignment = xlCenter
    Range("I:L").EntireColumn.HorizontalAlignment = xlCenter
    Range("M:N").EntireColumn.HorizontalAlignment = xlCenter


'*********************************************************************************

'Dim cell As Range
   
    For Each cell In Range("B:B").SpecialCells(xlCellTypeConstants)
        If cell Like "Route ID*" Then
               cell.Value = Trim(Mid(cell.Value, InStr(cell.Value, "-") + 1))
        End If
    Next cell
    
  Cells(2, 4).Select
      
'################################--Adjust drivers stops per address
  ' This loop runs as long as there is something in the next column
    Do While Not IsEmpty(ActiveCell.Offset(0, 1))
    ActiveCell.FormulaR1C1 = "=IF(EXACT(RC[1],R[-1]C[1]),0,1)"
    ActiveCell.Offset(1, 0).Select
    Loop
     Cells(2, 4).Select
Range("D:D").EntireColumn.Value = Range("D:D").EntireColumn.Value

ExitSub:

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub


Here is what I am attempting:
Customer Deliveries Report

ABCDEFGHIJKLMNO
1 Column I need to subtract 4:00 hours from each RowColumn J need to subtract 4:00 hours from each Row
2
3
4Route DateVehicle DescriptionOrder NoStop NoCustomerTownZip CodeDriverArrivalDepartureStop DurationDistanceTWI Open TimeTWI Close TimeSales Amount
510/3/20123037541Customer-1NEW YORK10011Brian 10:26 AM11:08 AM0:4256.7511:00 AM12:00 PM$314.58
610/3/20123037481Customer-2NEW YORK10001Brian 12:09 PM12:44 PM0:354.5412:00 PM1:00 PM$2,306.00
710/3/20123037541Customer-3NEW YORK10001Brian 1:15 PM1:25 PM0:104.371:00 PM2:00 PM$123.10
810/3/20123037511Customer-4NEW YORK10013Brian 1:51 PM3:18 PM1:265.3611:00 AM3:00 PM$1,689.40
9
10
11

<COLGROUP> <COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 93px"><COL style="WIDTH: 110px"><COL style="WIDTH: 110px"><COL style="WIDTH: 93px"><COL style="WIDTH: 60px"><COL style="WIDTH: 60px"><COL style="WIDTH: 93px"><COL style="WIDTH: 38px"><COL style="WIDTH: 74px"><COL style="WIDTH: 70px"><COL style="WIDTH: 78px"><COL style="WIDTH: 52px"><COL style="WIDTH: 86px"><COL style="WIDTH: 89px"><COL style="WIDTH: 80px"> </COLGROUP><TBODY>
</TBODY>


Excel tables to the web >> Excel Jeanie HTML 4

Any idea's and direction to accomplish this calculation would be appreciated
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
You need to deduct 4 hours not 4 days. Here is an example which allows for times before 4:00AM:

Code: 
Sub Deduct4Hours()
    Dim i As Long
    For i = 5 To 8
        With Range("I" & i)
            .Value = 1 + Range("Q" & i).Value - TimeValue("04:00")
            If .Value > 1 Then .Value = .Value - 1
        End With
    Next i
End Sub

By the way it's best to avoid giving variables names that are already used by VBA, eg Row.
 
Upvote 0
Thanks Andrew for the direction, What's your suggestion for placement of the code? This is the where the data gets imported to Range("I" & Row).Value = This is the imported source data sheet with this .Range("Q" & i).Value - 4
should I run this code after the import to change the value? Bute i see you reference Q The sample above with excel Jennie is the finish formated import. I only import columns I need.

Thanks again for your help
 
Upvote 0
No I was not. I am still working with the concept of the code loop. I also tried it as is and this was the result:

Customer Deliveries Report


ABCDEFGHIJKLMNOPQ
1Route
Date		Vehicle
Description		Order
No		Stop
No		CustomerTownZip
Code		DriverArrivalDepartureStop
Duration		DistanceTWI
Open Time		TWI
Close Time		Sales
Amount
210/3/20123037541Customer-1NEW YORK10011Brian 8:00 PM11:08 AM0:4256.7511:00 AM12:00 PM$314.58
310/3/20123037481Customer-2NEW YORK10001Brian 8:00 PM12:44 PM0:354.5412:00 PM1:00 PM$2,306.00
410/3/20123037541Customer-3NEW YORK10001Brian 8:00 PM1:25 PM0:104.371:00 PM2:00 PM$123.10
510/3/20123037511Customer-4NEW YORK10013Brian 8:00 PM3:18 PM1:265.3611:00 AM3:00 PM$1,689.40
6 8:00 PM
7 8:00 PM
8 8:00 PM
9
10


<colgroup>
<col style="width: 30px; font-weight: bold;">
<col style="width: 97px;">
<col style="width: 114px;">
<col style="width: 115px;">
<col style="width: 97px;">
<col style="width: 63px;">
<col style="width: 63px;">
<col style="width: 97px;">
<col style="width: 40px;">
<col style="width: 77px;">
<col style="width: 73px;">
<col style="width: 81px;">
<col style="width: 54px;">
<col style="width: 90px;">
<col style="width: 93px;">
<col style="width: 84px;">
<col style="width: 80px;">
<col style="width: 80px;"></colgroup>
<tbody>

</tbody>


Excel
tables to the web >> Excel Jeanie
HTML 4
 
Upvote 0
I am working on tring to add the code during import, but times not caculation right:

Code: 
' FIRST RANGE SHEET BEING IMPORTED TO, 2ND RANGE EXPORTED FROM
            Range("A" & Row).Value = .Range("A" & i).Value
            Range("B" & Row).Value = .Range("B" & i).Value
            Range("C" & Row).Value = .Range("D" & i).Value
            Range("D" & Row).Value = .Range("E" & i).Value
            Range("E" & Row).Value = .Range("F" & i).Value
            Range("F" & Row).Value = .Range("J" & i).Value
            Range("G" & Row).Value = .Range("L" & i).Value
            Range("H" & Row).Value = .Range("N" & i).Value
            Range("I" & Row).Value = .Range("Q" & i).Value
            Range("J" & Row).Value = .Range("T" & i).Value
            Range("L" & Row).Value = .Range("W" & i).Value
            Range("M" & Row).Value = .Range("AB" & i).Value
            Range("N" & Row).Value = .Range("AC" & i).Value
            ' Range K is a calculated field
        Next i
        
'ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
    Dim i As Long
    For i = 2 To LastRow
        With Range("I" & i)
            .Value = 1 + Range("Q" & i).Value - TimeValue("04:00")
            If .Value > 1 Then .Value = .Value - 1
        End With
    Next i
    End With
'ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
 
Upvote 0
The code I posted demonstrates how to deduct 4 hours from each cell in a loop. Adjust the loop to suit.
 
Upvote 0
Andrew Poulsom said:
The code I posted demonstrates how to deduct 4 hours from each cell in a loop. Adjust the loop to suit.
Click to expand...

I am not getting it, and can not adapt the code. Everytime I apply it and at all pointsin the code I places that I apply the loop, all times turn into 8:00 PM

Thanks for your wisdom and time, but it did not help me.

Thanks
 
Upvote 0
I tired the code on both the raw data input:Which the time Data is coming from and has to have 4:00 deducted.

Here is the raw data The time is in Q

Sheet1


A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U
V
W
X
Y
Z
AA
AB
AC
AD
AE
AF
AG
AH
AI
AJ
AK
1
Route Date
Route Description
Location Id
Order #
Stop #
Description
Addr Line 1
Addr line 2
Planned Stop
Town
St
Zip
Phone
Driver
Planned Arrival
Projected Arrival
Actual Arrival
Plan Departure
Projected Departure
Actual Departure
Planned Distance
Projected Distance
Actual Distance
Delay Type
Delay Minutes
Open Time
Close time
TW1 Open Time
TW1 Close Time
Instructions
Bill
Pay
Load ID
Date Modified
Zone
Sales Amount
2
3
###
Route ID: 1 - 303
100178430001
75471331
Stop 1
Customer1
242 WEST 20TH ST
BETWEEN 7TH & 8TH AV
1
NEW YORK
NY
10011
2129891320
Farrell, Brian P
#####
######
10:26 AM
10:03 AM
######
######
57.94
57.94
56.75
###
###
#######
#######
DEL WED SHOP
T
T
-1
######
1
314.58
4
###
Route ID: 1 - 303
100178430269
75475721
Stop 2
Customer2
101 BARCLAY STREET
FRT ON MURRAY ST X W
2
NEW YORK
NY
10007
2129891320
Farrell, Brian P
#####
######
11:45 AM
10:42 AM
######
######
2.27
2.27
3.03
###
###
#######
3:00 PM
DEL WED 7:30AM TAG-GROUND
FLOOR
T
T
-1
######
84.16
5
###
Route ID: 1 - 303
100178430269
75475831
Stop 2
Customer3
101 BARCLAY STREET
FRT ON MURRAY ST X W
2
NEW YORK
NY
10007
2129891320
Farrell, Brian P
#####
######
11:45 AM
10:42 AM
######
######
2.27
2.27
3.03
###
###
#######
3:00 PM
DEL WED 7:30AM TAG-GROUND
FLOOR
T
T
-1
######
127.17
6
###
Route ID: 1 - 303
100208950002
74844361
Stop 3
Customer4
7-PENN PLAZA
MADISON SQUARE GARDE
3
NEW YORK
NY
10001
5167405900
Farrell, Brian P
#####
######
12:09 PM
11:23 AM
######
######
3.33
3.33
4.54
###
###
#######
1:00 PM
DELIVER TO SITE WEDNESDAY
AM
T
T
-1
######
1
2,306.00
7
###
Route ID: 1 - 303
100208950003
73385091
Stop 4
Customer5
7 PENN PLAZA
MADISON SQUARE GARDE
4
NEW YORK
NY
10001
5167405900
Farrell, Brian P
#####
######
12:45 PM
11:23 AM
######
######
0.00
0.00
0.00
###
###
#######
7:00 PM
DELIVER TO SITE WEDNESDAY
AM
T
T
-1
######
1
1,440.00
8
###
Route ID: 1 - 303
100208950017
75474311
Stop 5
Customer6
7 PENN PLAZA
MADISON SQUARE GARDE
5
NYC
NY
10001
5167405900
Farrell, Brian P
#####
######
12:45 PM
11:23 AM
######
######
0.00
0.00
0.02
###
###
#######
7:00 PM
DELIVER TO SITE WEDNESDAY
AM
T
T
-1
######
2,001.00
9
###
Route ID: 1 - 303
100142900014
75456911
Stop 6
Customer7
110 LEROY STREET
C/S GREENWICH & HUDS
6
NEW YORK
NY
10001
2128746400
Farrell, Brian P
#####
######
1:15 PM
12:01 PM
######
######
1.65
1.65
4.37
###
###
1:00 PM
2:00 PM
PHONE-646-230-0417 OK TO DROP
OFF
T
T
-1
######
123.10
10
###
Route ID: 1 - 303
100035140296
75174101
Stop 7
Customer8
101 AVENUE OF THE AMERICAS
7
NEW YORK
NY
10013
7183896100
Farrell, Brian P
#####
######
1:51 PM
12:38 PM
######
######
0.99
0.99
5.36
###
###
#######
3:00 PM
DELIVER WEDS 10/3
T
T
-1
######
1,689.40
11
###
Route ID: 1 - 303
100035140296
75298191
Stop 7
Customer9
101 AVENUE OF THE AMERICAS
7
NEW YORK
NY
10013
7183896100
Farrell, Brian P
#####
######
1:51 PM
12:38 PM
######
######
0.99
0.99
5.36
###
###
#######
3:00 PM
DELIVER WEDS 10/3
T
T
-1
######
1,978.82
12
###
Route ID: 1 - 303
100136210228
75252871
Stop 8
BLACKMAN SHOWROOM AT
LYNBROOK
138 LEXINGTON AVENUE
X-29TH STREET
8
NEW YORK
NY
10016
5165933100
Farrell, Brian P
#####
######
3:18 PM
1:17 PM
######
######
2.42
2.42
0.12
###
###
3:00 PM
4:00 PM
PLEASE DELIVER ON WED 10/03 PER
CUST LEADTIME APPROX 2 WEEKS. THANK YOU- GAYLE S
T
T
-1
######
1,945.67

<tbody>
</tbody>


Excel
tables to the web >>

Customer Deliveries Report


A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
1
Route
Date
Vehicle
Description
Order
No
Stop
No
Customer
Town
Zip
Code
Driver
Arrival
Departure
Stop
Duration
Distance
TWI
Open Time
TWI
Close Time
2
10/3/2012
303
75471331
1
Customer 1
NEW YORK
10011
Brian
8:00
PM
11:08 AM
988431:08
56.75
11:00 AM
12:00 PM
3
10/3/2012
303
74844361
1
Customer 2
NEW YORK
10001
Brian
8:00
PM
12:44 PM
988432:44
4.54
12:00 PM
1:00 PM
4
10/3/2012
303
75456911
1
Customer 3
NEW YORK
10001
Brian
8:00
PM
1:25 PM
988433:25
4.37
1:00 PM
2:00 PM
5
10/3/2012
303
75174101
1
Customer 4
NEW YORK
10013
Brian
8:00
PM
3:18 PM
988435:18
5.36
11:00 AM
3:00 PM
6
10/3/2012
303
75252871
1
Customer 5
NEW YORK
10016
Brian
8:00
PM
3:31 PM
988435:31
0.12
3:00 PM
4:00 PM
7

<tbody>
</tbody>


Excel
tables to the web >> Excel Jeanie
HTML 4
This is the result of the code it is wrong.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA setting times of Copy & paste specific columns if the value is greater than 1
Replies
5
Views
293
JECYN
J
I
  • Question
Data formatting for Chart
Replies
3
Views
324
IREALLYambatman
I
Q
  • Solved
Calculating total number of hours within a period, counting only specific days of the week, and specific time intervals.
Replies
8
Views
631
Dave Patton
D
I
  • Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
94
irishjsk
I
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
223
B-radK
B

Forum statistics

Threads
1,214,987
Messages
6,122,618
Members
449,092
Latest member
amyap

Share this page

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