Advanced Search

Return to Snippet

Revision: 25667
at April 5, 2010 12:35 by obi
Initial Code 
Public Sub DateToQuarter()
    Dim cell As Range
    Set cell = ActiveCell
    Dim qtrNo, Year As Integer
    Do While Len(cell.Value) > 0
        Select Case Mid(cell.Value, 1, InStr(cell.Value, "/") - 1)
            Case "1"
                qtrNo = 1
            Case "4"
                qtrNo = 2
            Case "7"
                qtrNo = 3
            Case "10"
                qtrNo = 4
            Case Else
                MsgBox "there was an error!"
                GoTo ErrorHandle
        End Select
        
        Year = Mid(cell.Value, InStrRev(cell.Value, "/") + 1, 4)
        
        cell.Value = "Q" & qtrNo & " " & Year
        Set cell = cell.Offset(1, 0)
    Loop
    
ErrorHandle:
End Sub
Initial URL 

                                

                                                            

                                    

                                        

                                        Initial Description
                                        

                                    

                                    
USAGE: select first cell in column you wish to transform, then activate macro.

This macro will run for cell below (and including) the one you selected, and it will stop when it encounters the first blank cell in the column.

note: original date string must be in "m/d/yyyy" format

                                

                                                            

                                    

                                        

                                        Initial Title
                                        

                                    

                                    
Transform Date String to Quarter String

                                

                                                            

                                    

                                        

                                        Initial Tags
                                        

                                    

                                    

                                

                                                            

                                    

                                        

                                        Initial Language
                                        

                                    

                                    
Visual Basic