Link to home
Start Free TrialLog in
Avatar of Naresh Patel
Naresh PatelFlag for India

asked on

Formula in Last 3 Columns

I had this question after viewing TT Fresh Order Sheet Update..

Hi Experts,
i need to add formula in column Z AA AB  in sheet Fresh orders via VBA it self ..below is VBA ...i need to add lines which add formulas in above mention columns.
Column Z
=IF(Q2 = "","Not Assigned","Assigned")

Open in new window

(i guess already there in VBA
Column AA Same format which there in sheet
Column AB
=IF(B2-TODAY()<=0,"Black",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),"Red",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),"Blue",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),"Green",IF(B2-TODAY()>21,"Cyan","")))))

Open in new window


code
Sub UpdatingFresh()
    Dim wsImport As Worksheet
    Dim wsMaster As Worksheet

    Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    wsMaster.Activate
    For Each c In Range(Range("Y2"), Range("Y" & Rows.count).End(xlUp))
        If c = "Fresh" And c.Offset(, 10).Value = "Open" Then
            Set rngFound = Nothing
            Set rngFound = wsFresh.Range("D:D").Find(c.Offset(, -21), , , xlWhole)
            If Not rngFound Is Nothing Then
                'wsMaster.Range("AG" & c.Row).NumberFormat = "@"
                wsFresh.Range("A" & rngFound.Row, "AA" & rngFound.Row).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & rngFound.Row).Formula = "=IF(Q" & rngFound.Row & " = """",""Not Assigned"",""Assigned"")"
            Else
                wsFresh.Range("A" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1, "AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1).Formula = "=IF(Q" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1 & " = """",""Not Assigned"",""Assigned"")"
            End If
        End If
    Next
End Sub

Open in new window


See Attached

Thanks
---TT-WIP-D-1.xlsm
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Formula for column Z is already there, but the row reference must be changed when new are added (Else condition).
Column AB is a lot of conditional formulas.
If it exist no need to do anything, and for new easiest way is to copy from the cell above.
So the code will be this.
Sub UpdatingFresh()
    Dim wsImport As Worksheet
    Dim wsMaster As Worksheet

    Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    wsMaster.Activate
    For Each c In Range(Range("Y2"), Range("Y" & Rows.count).End(xlUp))
        If c = "Fresh" And c.Offset(, 10).Value = "Open" Then
            Set rngFound = Nothing
            Set rngFound = wsFresh.Range("D:D").Find(c.Offset(, -21), , , xlWhole)
            If Not rngFound Is Nothing Then
                'wsMaster.Range("AG" & c.Row).NumberFormat = "@"
                wsFresh.Range("A" & rngFound.Row, "AA" & rngFound.Row).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & rngFound.Row).Formula = "=IF(Q" & rngFound.Row & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & rngFound.Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
            Else
                wsFresh.Range("A" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1, "AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(Q" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1 & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
                wsFresh.Range("AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row - 1).Copy wsFresh.Range("AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row)
            End If
        End If
    Next
End Sub

Open in new window

Avatar of Naresh Patel

ASKER

if i clear whole Fresh Order Sheet and run above Sub ....conditional formatting column seems error...Column AA

Thanks
Yes, that is not possible.
The conditional format in AA are made with 10 different rules, so it will be a lot of work to create all.

One way could be to set the CF for AA1 also, and then copy formats from that, but a new set of rules will be made for all cells.
Instead expand the 10 CF ranges to be large enough, say AA2:AA500, then no need to do anything.
Delete the copy line in VBA, last line in the Else condition.
hmmm then we will set that rule in header it self ....what say?
Rule in the header does not matter, since all conditional rules will be false.
But is not needed, you can set the range to be from AA2 down to what you need.
In principle it can be the entire column, because one of the conditions are the value in column Z, and if not met, no CF set.
But calculation time could be increased too much by making the range too large, so limit to what is needed.
Deleting values in the range does not delete the CF rules, only "Delete all" deletes the format too.
if i clear sheet Fresh Orders and run sub there is 2 problem area
A) color code column CF blank and there is word "color code " in all column
B) Column Z has =IF(Q3 = "","Not Assigned","Assigned") formula in row 2 but it supose to =IF(Q2 = "","Not Assigned","Assigned").
User generated image
Thanks
ASKER CERTIFIED SOLUTION
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect
in above code line 2 is
Dim wsImport As Worksheet

Open in new window

i think it suppose to
Dim wsFreshOrders As Worksheet

Open in new window


just guessing not sure.

Thanks
There is no data in sheet Fresh Orders if you run Module N1_FreshRework - Sub UpdatingFresh().....getting same error for column Z.

See Attached

Thanks
WIP.xlsm
You are right
Dim wsImport As Worksheet
is not used for anything, and should be
Dim wsFresh As Worksheet
since that is used in the sub.

But since the module has no requirement for variable declaration it will work.
wsFresh will be declared when this statement are used
Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
c and rngFound are also not delclared, but as long as there are no misspelling it will work.

It is much better to use Option Explicit at the top of the module to require variable declaration.
Then misspelling and wrong use of variables will be found when compiling, and it is much easier to write the code.

Below code is changed to require declaration, and not declared variables defined.
When I run UpdatingFresh, sheet Fresh Orders are filled with data down to row 25, so what is the problem with column Z.

Option Explicit

Sub ReverseCheck()
    Dim wsRework As Worksheet
    Dim wsMaster As Worksheet
    Dim wsFresh As Worksheet
    Dim rngFound As Range, c As Range
        
    Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    Set wsRework = ThisWorkbook.Worksheets("Rework Oders")
    
    wsMaster.Activate
    For Each c In Range(Range("D2"), Range("D" & Rows.count).End(xlUp))
        If c.Offset(, 31).Value = "Close" Then
            Set rngFound = Nothing
            Set rngFound = wsFresh.Range("D:D").Find(c.Value, , , , xlWhole)
            If Not rngFound Is Nothing Then
                wsFresh.Rows(rngFound.Row).EntireRow.Delete
            End If
            Set rngFound = wsRework.Range("H:H").Find(c.Value, , , , xlWhole)
            If Not rngFound Is Nothing Then
                wsRework.Rows(rngFound.Row).EntireRow.Delete
            End If
        End If
    Next c
End Sub

Sub UpdatingFresh()
    Dim wsFresh As Worksheet
    Dim wsMaster As Worksheet
    Dim rngFound As Range, c As Range
    
    Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    wsMaster.Activate
    For Each c In Range(Range("Y2"), Range("Y" & Rows.count).End(xlUp))
        If c = "Fresh" And c.Offset(, 10).Value = "Open" Then
            Set rngFound = Nothing
            Set rngFound = wsFresh.Range("D:D").Find(c.Offset(, -21), , , xlWhole)
            If Not rngFound Is Nothing Then
                'wsMaster.Range("AG" & c.Row).NumberFormat = "@"
                wsFresh.Range("A" & rngFound.Row, "AA" & rngFound.Row).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & rngFound.Row).Formula = "=IF(Q" & rngFound.Row & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & rngFound.Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
            Else
                wsFresh.Range("A" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1, "AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(Q" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1 & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
            End If
        End If
    Next
End Sub

Open in new window

Formula in column ZUser generated imageThanks
i had done exact copy of above logic for sheet Rework Order let me know it is proper or not in this Question.

Thanks
There is an error in the formula, it has been there all the time, see first post here.
Here is a corrected sub.

Sub UpdatingFresh()
    Dim wsFresh As Worksheet
    Dim wsMaster As Worksheet
    Dim rngFound As Range, c As Range

    Set wsFresh = ThisWorkbook.Worksheets("Fresh Orders")
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    wsMaster.Activate
    For Each c In Range(Range("Y2"), Range("Y" & Rows.count).End(xlUp))
        If c = "Fresh" And c.Offset(, 10).Value = "Open" Then
            Set rngFound = Nothing
            Set rngFound = wsFresh.Range("D:D").Find(c.Offset(, -21), , , xlWhole)
            If Not rngFound Is Nothing Then
                'wsMaster.Range("AG" & c.Row).NumberFormat = "@"
                wsFresh.Range("A" & rngFound.Row, "AA" & rngFound.Row).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & rngFound.Row).Formula = "=IF(Q" & rngFound.Row & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & rngFound.Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
            Else
                wsFresh.Range("A" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1, "AA" & wsFresh.Range("A" & Rows.count).End(xlUp).Row + 1).Value = wsMaster.Range("A" & c.Row, "AA" & c.Row).Value
                wsFresh.Range("Z" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(Q" & wsFresh.Range("A" & Rows.count).End(xlUp).Row & " = """",""Not Assigned"",""Assigned"")"
                wsFresh.Range("AB" & wsFresh.Range("A" & Rows.count).End(xlUp).Row).Formula = "=IF(B2-TODAY()<=0,""Black"",IF(AND(B2-TODAY()>0,B2-TODAY()<=7),""Red"",IF(AND(B2-TODAY()>7,B2-TODAY()<=14),""Blue"",IF(AND(B2-TODAY()>14,B2-TODAY()<=21),""Green"",IF(B2-TODAY()>21,""Cyan"","""")))))"
            End If
        End If
    Next
End Sub

Open in new window