VBA - Look a Time Column hour in specfic column

LNG2013 · May 31, 2011

Hey everyone!

My data has a Time_Stamp column (see table below). My data is broken up by week.

I need to create some VBA code that looks at the Time_Stamp column, and then looks at the week column and fills in the corresponding columns for Hour (Hour1, Hour2, Hour3, or Hour4) and Minute (Minute1, Minute2, Minute3, or Minute4).

So if the time is 13:07 (1:07pm), and the week is week 1, Hour1= 1 and Minute1= 00. All other time fields in that row should be blank.

If the event occurs within 00-29 it equals 00. If the event occurs within 30-59 it equals 30.

Also I can only have the hours of 9:00am-2:30pm available. If it is past these hours nothing is filled in these columns and TimeNA1 (TimeNAWeek#), is filled in with a 1. The number 1 is the default for all of the NA columns.

All help is appreciated Thanks everyone for the assistance, still learning VBA!

Ralajer · May 31, 2011

Try this code. I was able to reproduce the your results with it.

Code:

Sub timeStamp()

    Dim stampRng As Range, cell As Range
    Dim offsetWeek As Integer
    Dim timeHour As Integer, timeMin As Integer
    Dim cellTime As Double
    
    Set stampRng = Range("A2:A9")                   '// Expand as needed

    For Each cell In stampRng
        
        offsetWeek = cell.offset(0, 1).Value        '// Week for output offset
        cellTime = cell.Value - Int(cell.Value)     '// Strip Out date
        timeHour = Hour(cellTime)                   '// Hour (24hr Clock)
        timeMin = Minute(cellTime)                  '// Minutes
        
        '// Bound checking 9:00am-2:30pm
        If cellTime < TimeValue("09:00 AM") Or cellTime > TimeValue("02:30 PM") Then
            cell.offset(0, offsetWeek + 9).Value = 1
        Else
            '// Adjust hours to use 12 hour clock
            If timeHour > 12 Then timeHour = (timeHour Mod 12)
            '// Output Hours
            cell.offset(0, 2 * offsetWeek).Value = timeHour
            
            '// Adjust Minutes out based on condition
            If timeMin > 30 Then timeMin = 30 Else timeMin = 0
            '// Output Minutes
            cell.offset(0, 2 * offsetWeek + 1).Value = timeMin
        End If
    Next cell
End Sub

Let me know if you have any question.

LNG2013 · Jun 1, 2011

Hey Rob!

Thanks for your help! That does the trick, but is there any way to have it so it has the same effect but if the columns are in a different order. My spreadsheet is usually around 100 columns and they change order all of the time... it's a real pain.

Thanks for all of your assistance! It's much appreciated!

Ralajer said:

Try this code. I was able to reproduce the your results with it.

Code:

Sub timeStamp()
 
    Dim stampRng As Range, cell As Range
    Dim offsetWeek As Integer
    Dim timeHour As Integer, timeMin As Integer
    Dim cellTime As Double
 
    Set stampRng = Range("A2:A9")                   '// Expand as needed
 
    For Each cell In stampRng
 
        offsetWeek = cell.offset(0, 1).Value        '// Week for output offset
        cellTime = cell.Value - Int(cell.Value)     '// Strip Out date
        timeHour = Hour(cellTime)                   '// Hour (24hr Clock)
        timeMin = Minute(cellTime)                  '// Minutes
 
        '// Bound checking 9:00am-2:30pm
        If cellTime < TimeValue("09:00 AM") Or cellTime > TimeValue("02:30 PM") Then
            cell.offset(0, offsetWeek + 9).Value = 1
        Else
            '// Adjust hours to use 12 hour clock
            If timeHour > 12 Then timeHour = (timeHour Mod 12)
            '// Output Hours
            cell.offset(0, 2 * offsetWeek).Value = timeHour
 
            '// Adjust Minutes out based on condition
            If timeMin > 30 Then timeMin = 30 Else timeMin = 0
            '// Output Minutes
            cell.offset(0, 2 * offsetWeek + 1).Value = timeMin
        End If
    Next cell
End Sub

Let me know if you have any question.

Ralajer · Jun 1, 2011

It can be changed to deal with changing columns position. Could elaborate on how the columns change, such as which columns are fixed which ones vary, do the headers stay the same, and so forth.

LNG2013 · Jun 1, 2011

No columns are fixed in place, they change positions all of the time... the headers always stay the same.

The headers are:
Time_Stamp, Week *del*, Hour1, Hour 2, Hour3, Hour4, Minute1, Minute2, Minute3, Minute4, TimeNA1, TimeNA2, TimeNA3, TimeNA4.

Thank you for all of your help!

Ralajer said:
It can be changed to deal with changing columns position. Could elaborate on how the columns change, such as which columns are fixed which ones vary, do the headers stay the same, and so forth.

Ralajer · Jun 1, 2011

Try this out. It finds the header and bases the output on the Column the headers are found. It's not perfect but it will work unless it can't find the header which should happen if it is are setup correctly.

Code:

Sub timeStamp2()

    Dim stampRng As Range, cell As Range
    Dim hdrRng As Range
    Dim numRows As Long             '// Number of Rows containing values in Time_Stamp Column
    Dim colTS As Integer            '// Column Number containing the Time_Stamp
    Dim colWK As Integer            '// Column Number containing the Week *del*
    Dim colHR As Integer            '// Column Number containing the Hour#
    Dim colMin As Integer           '// Column Number containing the Minute#
    Dim colTNA As Integer           '// Column Number containing the TimeNA#
    
    Dim valWK As Integer
    Dim timeHour As Integer, timeMin As Integer
    Dim cellTime As Double
    
    
    Set hdrRng = Range("A1:GR1")                    '// Header in GR=column 200
    '// Use find function to find the column number of the respective header
    colTS = hdrRng.Find(What:="Time_Stamp", LookIn:=xlValues, LookAt:=xlWhole).Column
    colWK = hdrRng.Find(What:="Week *del*", LookIn:=xlValues, LookAt:=xlWhole).Column
    
    
    numRows = Excel.WorksheetFunction.CountA(Range(Cells(2, colTS), Cells(65535, colTS)))
    
    Set stampRng = Range(Cells(2, colTS), Cells(numRows, colTS))

    
    For Each cell In stampRng
        valWK = cell.offset(0, colWK - colTS).Value      '// Week for output offset
        cellTime = cell.Value - Int(cell.Value)     '// Strip Out date
        timeHour = Hour(cellTime)                   '// Hour (24hr Clock)
        timeMin = Minute(cellTime)                  '// Minutes
    
        
        '// Use find function to find the column number of the respective header
        colHR = hdrRng.Find(What:="Hour" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column         '// Column of Hour&Week
        colMin = hdrRng.Find(What:="Minute" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column       '// Column of Minute&Week
        colTNA = hdrRng.Find(What:="TimeNA" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column       '// Column of TimeNA&Week
        
        
        '// Bound checking 9:00am-2:30pm
        If cellTime < TimeValue("09:00 AM") Or cellTime > TimeValue("02:30 PM") Then
        
            cell.offset(0, colTNA - colTS).Value = 1
        Else
            '// Adjust hours to use 12 hour clock
            If timeHour > 12 Then timeHour = (timeHour Mod 12)
            '// Output Hours
            cell.offset(0, colHR - colTS).Value = timeHour
            
            '// Adjust Minutes out based on condition
            If timeMin > 30 Then timeMin = 30 Else timeMin = 0
            '// Output Minutes
            cell.offset(0, colMin - colTS).Value = timeMin
        End If
    Next cell
End Sub

LNG2013 · Jun 2, 2011

Hey Rob this worked VERY VERY well. The only issue I am running into, it seems to always miss the last row... any ideas?

Ralajer said:

Try this out. It finds the header and bases the output on the Column the headers are found. It's not perfect but it will work unless it can't find the header which should happen if it is are setup correctly.

Code:

Sub timeStamp2()
 
    Dim stampRng As Range, cell As Range
    Dim hdrRng As Range
    Dim numRows As Long             '// Number of Rows containing values in Time_Stamp Column
    Dim colTS As Integer            '// Column Number containing the Time_Stamp
    Dim colWK As Integer            '// Column Number containing the Week *del*
    Dim colHR As Integer            '// Column Number containing the Hour#
    Dim colMin As Integer           '// Column Number containing the Minute#
    Dim colTNA As Integer           '// Column Number containing the TimeNA#
 
    Dim valWK As Integer
    Dim timeHour As Integer, timeMin As Integer
    Dim cellTime As Double
 
 
    Set hdrRng = Range("A1:GR1")                    '// Header in GR=column 200
    '// Use find function to find the column number of the respective header
    colTS = hdrRng.Find(What:="Time_Stamp", LookIn:=xlValues, LookAt:=xlWhole).Column
    colWK = hdrRng.Find(What:="Week *del*", LookIn:=xlValues, LookAt:=xlWhole).Column
 
 
    numRows = Excel.WorksheetFunction.CountA(Range(Cells(2, colTS), Cells(65535, colTS)))
 
    Set stampRng = Range(Cells(2, colTS), Cells(numRows, colTS))
 
 
    For Each cell In stampRng
        valWK = cell.offset(0, colWK - colTS).Value      '// Week for output offset
        cellTime = cell.Value - Int(cell.Value)     '// Strip Out date
        timeHour = Hour(cellTime)                   '// Hour (24hr Clock)
        timeMin = Minute(cellTime)                  '// Minutes
 
 
        '// Use find function to find the column number of the respective header
        colHR = hdrRng.Find(What:="Hour" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column         '// Column of Hour&Week
        colMin = hdrRng.Find(What:="Minute" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column       '// Column of Minute&Week
        colTNA = hdrRng.Find(What:="TimeNA" & valWK, LookIn:=xlValues, LookAt:=xlWhole).Column       '// Column of TimeNA&Week
 
 
        '// Bound checking 9:00am-2:30pm
        If cellTime < TimeValue("09:00 AM") Or cellTime > TimeValue("02:30 PM") Then
 
            cell.offset(0, colTNA - colTS).Value = 1
        Else
            '// Adjust hours to use 12 hour clock
            If timeHour > 12 Then timeHour = (timeHour Mod 12)
            '// Output Hours
            cell.offset(0, colHR - colTS).Value = timeHour
 
            '// Adjust Minutes out based on condition
            If timeMin > 30 Then timeMin = 30 Else timeMin = 0
            '// Output Minutes
            cell.offset(0, colMin - colTS).Value = timeMin
        End If
    Next cell
End Sub

Ralajer · Jun 2, 2011

I see the problem I missed used the number of row in the range as the row number in reference the last row of date/times.

Replace the

Code:

Set stampRng = Range(Cells(2, colTS), Cells(numRows, colTS))

With

Code:

Set stampRng = Range(Cells(2, colTS), Cells(numRows + 1, colTS))

LNG2013 · Jun 2, 2011

That worked perfectly! Thank you!

VBA - Look a Time Column hour in specfic column

LNG2013

Active Member

Excel Facts

Ralajer

Active Member

LNG2013

Active Member

Ralajer

Active Member

LNG2013

Active Member

Ralajer

Active Member

LNG2013

Active Member

Ralajer

Active Member

LNG2013

Active Member

Similar threads

Forum statistics

Share this page

VBA - Look a Time Column hour in specfic column

Active Member

Excel Facts

Active Member

Active Member

Active Member

Active Member

Active Member

Active Member

Active Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock