Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 49895

Macro to input formula in missing D column and undo merge cells in a certain range

$
0
0
So I have a worksheet that when freelancers enter in the days of the week they have off (in cells N4:N6), the time formula is deleted in D in every row for that day of the week, and columns E:R are merged with the words DAY OFF for that day of the week.

The macro I coded works great! SO this is what it looks like after the days off macro has been run:

example days off.png

Next to every Friday and Sunday, the formula in D has been cleared and E:R are merged with the words "DAY OFF."

Macro I coded to do that:

Code:

Sub DaysOff()

    Dim rngAlldays As Range
    Dim c1 As Range, c2 As Range, c3 As Range
   
    Set rngAlldays = Worksheets("Scheduler").Range("A10:A450")
   
   
    If ActiveSheet.Range("N4") <> "" Then
    'Do Nothing
   
   
    For Each c1 In rngAlldays
        If c1.Value = ActiveSheet.Range("N4") Then
            c1.Select
            ActiveCell.Offset(0, 3).ClearContents
            c1.Select
            ActiveCell.Offset(0, 4).Value = "OFF DAY"
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Merge
            End With
   
        End If
        Next c1
       
    End If
   
    If ActiveSheet.Range("N5") <> "" Then
    'Do Nothing
   
   
    For Each c2 In rngAlldays
        If c2.Value = ActiveSheet.Range("N5") Then
            c2.Select
            ActiveCell.Offset(0, 3).ClearContents
            c2.Select
            ActiveCell.Offset(0, 4).Value = "OFF DAY"
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Merge
            End With
   
        End If
        Next c2
       
    End If
       
   
    If ActiveSheet.Range("N6") <> "" Then
    'Do Nothing
   
   
    For Each c3 In rngAlldays
        If c3.Value = ActiveSheet.Range("N6") Then
            c3.Select
            ActiveCell.Offset(0, 3).ClearContents
            c3.Select
            ActiveCell.Offset(0, 4).Value = "OFF DAY"
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Merge
            End With
   
        End If
        Next c3
       
    End If

End Sub

QUESTION: NEED TO CODE RESET BUTTON

But if the user no longer has Friday off later on in the year, I want to code a reset button where for all the Fridays (or whatever day off they put in N4) the formulas will be restored and the cells not merged. But I can't figure out how to reset the formulas. Everything i tried didn't work. I did get the unmerge part to work.


The formula is the same as the row above it. So for example if Friday is in row 45, then I just need the code in row 44 to be copied down with the row number changed to 44.

This is the formula:
Formula:
=CHOOSE(WEEKDAY(B15,2),$J$4,$J$5,$J$6,$J$7,$L$4,$L$5,$L$6)-C15
(where the row number [15 in this example] changes depending on the row the formula is in.

Any ideas on how I could reset the formula in this code:

Code:

Sub Reset()

    Dim rngAlldays As Range
    Dim c1 As Range, c2 As Range, c3 As Range
   
    Set rngAlldays = Worksheets("Scheduler").Range("A10:A450")
   
    If ActiveSheet.Range("N4") <> "" Then
    For Each c1 In rngAlldays
        If c1.Value = ActiveSheet.Range("N4") Then
          c1.Select
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .UnMerge
            End With
   
        End If
        Next c1
       
   
    End If
   
    If ActiveSheet.Range("N5") <> "" Then
    'Do Nothing
   
   
    For Each c2 In rngAlldays
      If c2.Value = ActiveSheet.Range("N5") Then
            c2.Select
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .UnMerge
            End With
   
        End If
        Next c2
   
       
    End If
       
   
    If ActiveSheet.Range("N6") <> "" Then
    'Do Nothing
   
   
    For Each c3 In rngAlldays
        c3.Select
        If c3.Value = ActiveSheet.Range("N6") Then
            Range(ActiveCell.Offset(0, 4), ActiveCell.Offset(0, 17)).Select
            With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .UnMerge
            End With
        End If
        Next c3
       
    End If

End Sub


Viewing all articles
Browse latest Browse all 49895

Trending Articles