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
Customer-1NEW YORKBrian
Customer-2NEW YORKBrian
Customer-3NEW YORKBrian
Customer-4NEW YORKBrian

<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>
[TD="bgcolor: #cacaca, align: center"]1[/TD]

[TD="align: center"]Column I need to subtract 4:00 hours from each Row[/TD]
[TD="align: center"]Column J need to subtract 4:00 hours from each Row[/TD]

[TD="bgcolor: #cacaca, align: center"]2[/TD]

[TD="bgcolor: #cacaca, align: center"]3[/TD]

[TD="bgcolor: #cacaca, align: center"]4[/TD]
[TD="bgcolor: #99ccff, align: center"]Route Date[/TD]
[TD="bgcolor: #99ccff, align: center"]Vehicle Description[/TD]
[TD="bgcolor: #99ccff, align: center"]Order No[/TD]
[TD="bgcolor: #99ccff, align: center"]Stop No[/TD]
[TD="bgcolor: #99ccff, align: center"]Customer[/TD]
[TD="bgcolor: #99ccff, align: center"]Town[/TD]
[TD="bgcolor: #99ccff, align: center"]Zip Code[/TD]
[TD="bgcolor: #99ccff, align: center"]Driver[/TD]
[TD="bgcolor: #99ccff, align: center"]Arrival[/TD]
[TD="bgcolor: #99ccff, align: center"]Departure[/TD]
[TD="bgcolor: #99ccff, align: center"]Stop Duration[/TD]
[TD="bgcolor: #99ccff, align: center"]Distance[/TD]
[TD="bgcolor: #99ccff, align: center"]TWI Open Time[/TD]
[TD="bgcolor: #99ccff, align: center"]TWI Close Time[/TD]
[TD="bgcolor: #99ccff, align: center"]Sales Amount[/TD]

[TD="bgcolor: #cacaca, align: center"]5[/TD]
[TD="align: center"]10/3/2012[/TD]
[TD="align: right"]303[/TD]
[TD="align: center"]754[/TD]
[TD="align: center"]1[/TD]

[TD="align: center"]10011[/TD]

[TD="align: center"]10:26 AM[/TD]
[TD="align: center"]11:08 AM[/TD]
[TD="align: center"]0:42[/TD]
[TD="align: center"]56.75[/TD]
[TD="align: center"]11:00 AM[/TD]
[TD="align: center"]12:00 PM[/TD]
[TD="align: right"]$314.58[/TD]

[TD="bgcolor: #cacaca, align: center"]6[/TD]
[TD="align: center"]10/3/2012[/TD]
[TD="align: right"]303[/TD]
[TD="align: center"]748[/TD]
[TD="align: center"]1[/TD]

[TD="align: center"]10001[/TD]

[TD="align: center"]12:09 PM[/TD]
[TD="align: center"]12:44 PM[/TD]
[TD="align: center"]0:35[/TD]
[TD="align: center"]4.54[/TD]
[TD="align: center"]12:00 PM[/TD]
[TD="align: center"]1:00 PM[/TD]
[TD="align: right"]$2,306.00[/TD]

[TD="bgcolor: #cacaca, align: center"]7[/TD]
[TD="align: center"]10/3/2012[/TD]
[TD="align: right"]303[/TD]
[TD="align: center"]754[/TD]
[TD="align: center"]1[/TD]

[TD="align: center"]10001[/TD]

[TD="align: center"]1:15 PM[/TD]
[TD="align: center"]1:25 PM[/TD]
[TD="align: center"]0:10[/TD]
[TD="align: center"]4.37[/TD]
[TD="align: center"]1:00 PM[/TD]
[TD="align: center"]2:00 PM[/TD]
[TD="align: right"]$123.10[/TD]

[TD="bgcolor: #cacaca, align: center"]8[/TD]
[TD="align: center"]10/3/2012[/TD]
[TD="align: right"]303[/TD]
[TD="align: center"]751[/TD]
[TD="align: center"]1[/TD]

[TD="align: center"]10013[/TD]

[TD="align: center"]1:51 PM[/TD]
[TD="align: center"]3:18 PM[/TD]
[TD="align: center"]1:26[/TD]
[TD="align: center"]5.36[/TD]
[TD="align: center"]11:00 AM[/TD]
[TD="align: center"]3:00 PM[/TD]
[TD="align: right"]$1,689.40[/TD]

[TD="bgcolor: #cacaca, align: center"]9[/TD]

[TD="bgcolor: #cacaca, align: center"]10[/TD]

[TD="bgcolor: #cacaca, align: center"]11[/TD]

</TBODY>


Excel tables to the web >> Excel Jeanie HTML 4

Any idea's and direction to accomplish this calculation would be appreciated
 
Sort by date Sort by votes
Andrew

Here is how I got it to work by adding part of the loopformula to deduct the 4 hours - TimeValue("04:00")
by adding that to the input code where it takes it from column Q from the raw data does the calculation and adds the result of the calculation into Row I.



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 - TimeValue("04:00")
            Range("J" & Row).Value = .Range("T" & i).Value - TimeValue("04:00")
            Range("L" & Row).Value = .Range("W" & i).Value
            Range("M" & Row).Value = .Range("AB" & i).Value
            Range("N" & Row).Value = .Range("AC" & i).Value


Thanks for baiting me in the right direct and giving me a hint of the clue.

Thank you much appreciated
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
You must log in or register to reply here.

Similar threads

S
  • Solved
Delete rows before a certain time
2 3
Replies
26
Views
762
Joe4
Joe4
tezza
  • Solved
Calculate time from two columns
Replies
4
Views
200
tezza
tezza
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
329
RoryA
RoryA
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
79
6StringJazzer
6StringJazzer
E
  • Question Question
VBA code clean up
Replies
9
Views
536
mumps
mumps

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

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