Consulting

Results 1 to 10 of 10

Thread: Help transforming dates and rounding numbers using VBA

  1. #1
    VBAX Regular
    Joined
    Mar 2013
    Posts
    51
    Location

    Help transforming dates and rounding numbers using VBA

    I have a large spreadsheet with 2 columns that I would like to use VBA in excel to transform. The first column is column A that has the date and time. In column A, the date is formatted mm/dd/yyyy followed by the time in 00:00. There is a space in between the date and the time. I would like to delete the time altogether and change the date to yyyy/mm/dd. The second column is column E. In this column, there is a total that I would like to have rounded to the nearest 5th number (ie 0, 5, 10, 15, 20, 25...so if the number is 621 it would round to 620 or 24 would round to 25).

    At the bottom of the last row, I would like the row count to be displayed along with the sum of column E.

    If someone knows how to easily do this with VBA, that would be awesome and would save me a bunch of time. Thanks alot for your help.

  2. #2
    VBAX Contributor
    Joined
    Dec 2009
    Location
    Sevastopol
    Posts
    150
    Location
    Try this:
    Sub AllYouWant()
     
      Dim a As Range
     
      ' Trim the time part from the date+time constants in A-Column
      With Intersect(ActiveSheet.UsedRange, Columns("A"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
          a.Value = Evaluate("TRUNC(" & a.Address & ")")
        Next
        .NumberFormat = "yyyy/mm/dd"
      End With
     
      ' Round to the nearest 5*N the numeric constants in E-column
      With Intersect(ActiveSheet.UsedRange, Columns("E"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
          a.Value = Evaluate("ROUND(" & a.Address & "*2,-1)/2")
        Next
      End With
     
      ' Write formula to the bottom cell in E-column to sum the cells above
      If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
      With Cells(Rows.Count, "E").End(xlUp)
        If Not .HasFormula Then
          .Offset(1).Formula = "=SUM(E1:E" & .Row & ")"
        End If
      End With
     
    End Sub

  3. #3
    VBAX Regular
    Joined
    Mar 2013
    Posts
    51
    Location

    Great, but not quite.

    This VBA code will convert the first row as described; however, it will convert all the following rows to be exactly like the first row. How do you get the VBA code to distinguish between rows? Also, the sum at the bottom works, but can the code be written to also have a row count in the cell to the right of the sum for column E. Thanks alot this is great!

    Quote Originally Posted by ZVI View Post
    Try this:
    Sub AllYouWant()
     
      Dim a As Range
     
      ' Trim the time part from the date+time constants in A-Column
      With Intersect(ActiveSheet.UsedRange, Columns("A"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
          a.Value = Evaluate("TRUNC(" & a.Address & ")")
        Next
        .NumberFormat = "yyyy/mm/dd"
      End With
     
      ' Round to the nearest 5*N the numeric constants in E-column
      With Intersect(ActiveSheet.UsedRange, Columns("E"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
          a.Value = Evaluate("ROUND(" & a.Address & "*2,-1)/2")
        Next
      End With
     
      ' Write formula to the bottom cell in E-column to sum the cells above
      If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
      With Cells(Rows.Count, "E").End(xlUp)
        If Not .HasFormula Then
          .Offset(1).Formula = "=SUM(E1:E" & .Row & ")"
        End If
      End With
     
    End Sub

  4. #4
    VBAX Regular
    Joined
    Mar 2013
    Posts
    51
    Location
    I'm sorry. Row count to the left of column E would be great. Also, all the columns in between columns A and E are just fine. It is that the VBA code basically copies the values of A1 and E1 to all the other cells in A and E.

  5. #5
    VBAX Contributor
    Joined
    Dec 2009
    Location
    Sevastopol
    Posts
    150
    Location
    Code skips the cells with formulas.
    If something does not meet your expectation, could you please attach an example with the (dummy) data layout?

  6. #6
    VBAX Regular
    Joined
    Mar 2013
    Posts
    51
    Location
    Thanks for your response and your help with the code. I have attached a sample file with the VBA code. The first worksheet has the original information. The 2nd worksheet has the output from the VBA code. In the second worksheet, it appears that the code performs the correct actions on the first row, but then copies that over to the remaining rows. There are no formulas in the data for the VBA to skip over. If you can get this to work that would be great. Also, if you can add a row count to the left of the sum of E that would be awesome. You are the best! Thanks.



    Quote Originally Posted by ZVI View Post
    Code skips the cells with formulas.
    If something does not meet your expectation, could you please attach an example with the (dummy) data layout?
    Attached Files Attached Files

  7. #7
    VBAX Contributor
    Joined
    Dec 2009
    Location
    Sevastopol
    Posts
    150
    Location
    My bad - INDEX was missing in Evaluate's argument.
    The fixed code is as follows:
    Sub AllYouWant()
     
      Dim a As Range
     
      ' Trim the time part from the date+time constants in A-Column
      With Intersect(ActiveSheet.UsedRange, Columns("A"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
           a.Value = Evaluate("INDEX(TRUNC(" & a.Address & "),)")
        Next
        .NumberFormat = "yyyy/mm/dd"
      End With
     
      ' Round to the nearest 5*N the numeric constants in E-column
      With Intersect(ActiveSheet.UsedRange, Columns("E"))
        For Each a In .SpecialCells(xlCellTypeConstants, xlNumbers).Areas
           a.Value = Evaluate("INDEX(ROUND(" & a.Address & "*2,-1)/2,)")
        Next
      End With
     
      ' Write formula to the bottom cell in E-column to sum the cells above
      If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
      With Cells(Rows.Count, "E").End(xlUp)
        If .HasFormula Then
          If .Formula Like "=SUM(*E*:*E*)" Then
            .Formula = "=SUM(E1:E" & .Row - 1 & ")"
          End If
        Else
          .Offset(1).Formula = "=SUM(E1:E" & .Row & ")"
        End If
      End With
     
    End Sub
    The code should be in standard module (VBE - menu Insert - Module), not in the sheet's one.

    The fixed example is attached.
    Attached Files Attached Files

  8. #8
    VBAX Contributor
    Joined
    Dec 2009
    Location
    Sevastopol
    Posts
    150
    Location
    And here is the same but with COUNT to the left of the SUM of E
    Attached Files Attached Files

  9. #9
    VBAX Regular
    Joined
    Mar 2013
    Posts
    51
    Location
    Awesome! Thanks this is great!

  10. #10
    VBAX Contributor
    Joined
    Dec 2009
    Location
    Sevastopol
    Posts
    150
    Location
    Glad it works for you!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •