VBA Macro to Replace Value with Formula

  • Hi - I have an export that exports a report into excel sub-grouped into weekly buckets.



    I need to put a calculation in where the "1/01/1900" date appears to calculate the percent of the two subtotals before it like it does daily. So instead of "1/01/1900" i would need to say =(23.21/101.25) for the "1st Week" and follow suit for the "2nd Week" and so on.


    I would also like to clean up the repetitive data in the first 2 columns. This can vary by number of dates that exist with a possibility of 1-5 consecutive groups of dates. Ultimately i would like it to look like the following:



    I have multiple worksheets on my export with the same format, so i would like to run the macro across all worksheets.


    Any help would be much appreciated :)


    Thanks for reading!

  • Hello,


    You can test following

    Code
    1. Sub Adjust()
    2. Dim last As Long
    3. Dim c As Range, rng As Range
    4. last = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
    5. Set rng = Sheet1.Range("B2:B" & last)
    6. For Each c In rng
    7. If c = "Total Week" Then c.Offset(0, 6) = Evaluate("=F" & c.Row & "/G" & c.Row & ""): c.Offset(0, 6).NumberFormat = "0.00%"
    8. Next c
    9. End Sub


    Hope this will help

    Files

    • Test DGWin.xlsm

      (34.5 kB, downloaded 55 times, last: )

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Thanks so much!!! It works perfectly! Would it be possible to have it run on all sheets in the workbook though so i don't have to run the macro on each tab? I tried to add the code to do this but was unsuccessful......

  • You are welcome :)


    Are you sure you need a loop for all the sheets ...?


    Don't you have like an index sheet which would be an exception ...?

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Re,


    If there is no exception ... you can test following


    Hope this will help

    Files

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Hi Carim! My export comes out with multiple tabs (one for each Group). So in the example file, I just have Group A showing but I actually have several tabs - 1 for each different group. The code works fine, I just have to click on each tab and run it. I was hoping to avoid having to run it on each tab.

  • Re,


    Have you tested the macro in message # 8 ...?

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Thanks Carim! It works for the most part. The strangest thing happens..... randomly it seems i get a #DIV/0 error that comes up on subsequent sheets.



    Not everywhere but just in some spots....... if i go and re-run the macro on the sheet where the error occurs it'll work. ;(

  • If all of your data is generated by some kind of a download ... you could be facing a famous issue :


    some cells are downloaded as Text ... and not as Values ... which would explain the errors ...


    You should look into this aspect ...

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Thanks so much Carim! You've got me alot closer than I was. It's weird. Whatever tab I run the macro from will work perfectly, the other tabs, the calculation randomly works or returns the division by zero error. So for example, if i go to another tab and re-run, that tab will work perfectly even though it had the division errors before. I really appreciate your efforts here. I'll keep investigating.......... If i absolutely can't figure it out, i'll upload a sample workbook. Thanks again!!!!

  • You are welcome ;)


    Thanks for your Thanks AND for the Like :)

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Thumbs Up" icon, below, in the bottom right corner:)

  • Carim - so i actually stumbled on the solution! I needed to Activate each sheet


    Sub Adjust()

    Dim last As Long

    Dim c As Range, rng As Range

    Dim sh As Worksheet

    For Each sh In ActiveWorkbook.Sheets

    sh.Activate

    last = sh.Cells(Rows.Count, 2).End(xlUp).Row

    Set rng = sh.Range("B2:B" & last)

    For Each c In rng

    If c = "Total Week" Then c.Offset(0, 6) = Evaluate("=F" & c.Row & "/G" & c.Row & ""): c.Offset(0, 6).NumberFormat = "0.00%"

    Next c

    Next sh

    End Sub


    Works perfectly!!!!

    Thank you so much!!!!!