Copy Formula to last row Via Macro

[neb255]

hi,

i have the following Macro which is supposed to insert a formula in H2, I2, & J2 and copy it down to the last row of column H, I, & J which have data in column A.

it places the formula in the correct cell, however then instead of copying the formula to the last row of column H, I & J it copys it into Cells H1, I1, J1

i need to be able to do this on several sheets where the number of rows of data in column A are not always going to be the same



'Capture Last Row
Dim lastrowa As Long
lastrowa = ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row

'Add Columns Todays Status, Update, & Reg Notes
Sheets("OldData").Select
Range("H1:J1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("H1").Select
ActiveCell.FormulaR1C1 = "Todays Status"
Range("I1").Select
ActiveCell.FormulaR1C1 = "UPDATE"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Reg Notes"
Columns("H:J").EntireColumn.AutoFit

'Check Todays Reg
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],RegData!C[-4]:C[-3],2,FALSE)),""DEGRADED"",""OPERATIONAL"")"
Selection.AutoFill Destination:=Range("H2:H" & lastrowa)

'Update Date
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-7]=RC[-1],RC[-5],TODAY())"
Selection.AutoFill Destination:=Range("I2:I" & lastrowa)
Columns("I:I").Select
Selection.NumberFormat = "m/d/yyyy"

'Update Reg Status
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=RC[-2],RC[-3],CONCATENATE(RC[-3],"" "",TEXT(RC[-6],""mm/dd/yyyy"")))"
Selection.AutoFill Destination:=Range("J2:J" & lastrowa)


i appreciate your help!!!

 

[andiemac]

Looks like it should work, and worked for me when I tested it.

My only thought is that you are determining lastrowa based on ActiveSheet. If you are actually tring to get the last row on "OldData" but your active sheet has nothing in column A you wouldn't be getting the range you hoped for. You may want to activate "OldData" before setting lastrowa.

Infact, since your A range will change for each tab, you would want to set lastrowa for each tab.

 

[p45cal]

This works on the active sheet:

'Capture Last Row
With ActiveSheet
    Dim lastrowa As Long
    lastrowa = .Range("a" & Rows.Count).End(xlUp).Row

    'Add Columns Todays Status, Update, & Reg Notes
    'Sheets("OldData").Select
    With .Range("H1:J1")
        .Font.Bold = True
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    .Range("H1").Value = "Todays Status"
    .Range("I1").Value = "UPDATE"
    .Range("J1").Value = "Reg Notes"
    .Columns("H:J").EntireColumn.AutoFit

    'Check Todays Reg
    .Range("H2:H" & lastrowa).FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],RegData!C[-4]:C[-3],2,FALSE)),""DEGRADED"",""OPERATIONAL"")"

    'Update Date
    With .Range("I2:I" & lastrowa)
        .FormulaR1C1 = "=IF(RC[-7]=RC[-1],RC[-5],TODAY())"
        .NumberFormat = "m/d/yyyy"
    End With

    'Update Reg Status
    .Range("J2:J" & lastrowa).FormulaR1C1 = "=IF(RC[-8]=RC[-2],RC[-3],CONCATENATE(RC[-3],"" "",TEXT(RC[-6],""mm/dd/yyyy"")))"
End With    'Activesheet

 

[neb255]

This works on the active sheet:

'Capture Last Row
With ActiveSheet
    Dim lastrowa As Long
    lastrowa = .Range("a" & Rows.Count).End(xlUp).Row

    'Add Columns Todays Status, Update, & Reg Notes
    'Sheets("OldData").Select
    With .Range("H1:J1")
        .Font.Bold = True
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    .Range("H1").Value = "Todays Status"
    .Range("I1").Value = "UPDATE"
    .Range("J1").Value = "Reg Notes"
    .Columns("H:J").EntireColumn.AutoFit

    'Check Todays Reg
    .Range("H2:H" & lastrowa).FormulaR1C1 = "=IF(ISNA(VLOOKUP(RC[-2],RegData!C[-4]:C[-3],2,FALSE)),""DEGRADED"",""OPERATIONAL"")"

    'Update Date
    With .Range("I2:I" & lastrowa)
        .FormulaR1C1 = "=IF(RC[-7]=RC[-1],RC[-5],TODAY())"
        .NumberFormat = "m/d/yyyy"
    End With

    'Update Reg Status
    .Range("J2:J" & lastrowa).FormulaR1C1 = "=IF(RC[-8]=RC[-2],RC[-3],CONCATENATE(RC[-3],"" "",TEXT(RC[-6],""mm/dd/yyyy"")))"
End With    'Activesheet

Just to confirm, I should then be able to use lastrowa on any active sheet?

Cheers

 

[p45cal]

Everytime you run the macro, it will act on the active sheet (the one showing) at the time, and it will determine lastrowa from the data on that active sheet - which seems to be what you want (?).

 

[neb255]

yup....so im using "With Activesheet" that you suggested, and it seems to be helping in most places, however i am still running into a problem where when the macro gets to the autofill it fills cells H1 & H2 instead of filling down to the last row....

any ideas on that? should i be using fill down instead?

 

[neb255]

sorry cant figure out how to delete that last message, i missed part of your code you changed...ill try it and let you know.

thanks

 

[neb255]

i made the changes to the autofill formula but didnt use the With Activesheet and it works great.....you just cut my code in half......

i appreciate your help
Cheers

 

[neb255]

it seems i spoke too soon.

when i run the macro by F8 and go line by line it seems to work ok, however if i run it as a whole then it is still copying the formula to row 1 instead of filling it down.

here is the complete macro.

any help is appreciated




Sub RegUpdate()
'
' RegUpdate Macro
'


'Capture Last Row
Dim lastrowb As Long
lastrowb = Range("b" & Rows.Count).End(xlDown).End(xlUp).Row
Dim lastrowa As Long
lastrowa = Range("a" & Rows.Count).End(xlDown).End(xlUp).Row
Dim lastrowc As Long
lastrowc = Range("c" & Rows.Count).End(xlDown).End(xlUp).Row


'Unhide OldData
Sheets("OldData").Visible = True

'Pull Client ID From Reg Data
Sheets("RegData").Select
Range("A1").Value = "WTN"
Range("B1").Value = "Details"
Range("A2:A" & lastrowa).Select
Selection.ClearContents
Range("a2:a" & lastrowb).FormulaR1C1 = "=VALUE(MID(RC[1],25,10))"


'Refresh Pivot Table
Dim PT As PivotTable
For Each PT In ActiveSheet.PivotTables
PT.RefreshTable
Next PT

'Clear OldData
Sheets("OldData").Select
Cells.Select
Selection.Delete Shift:=xlUp

'Copy Yesterdays Data
Sheets("Active").Select
Range("A:E,L:L,R:R").Select
Selection.Copy
Sheets("OldData").Select
ActiveSheet.Paste


'Add Columns Todays Status, Update, & Reg Notes
Sheets("OldData").Select
Range("H1:J1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("H1").Value = "Todays Status"
Range("I1").Value = "UPDATE"
Range("J1").Value = "Reg Notes"
Columns("H:J").EntireColumn.AutoFit

'Check Todays Reg
Range("H2:H" & lastrowa).FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-2],RegData!C[-4]:C[-3],2,FALSE)),""DEGRADED"",""OPERATIONAL"")"

'Update Date
With Range("I2:I" & lastrowa)
.FormulaR1C1 = "=IF(RC[-7]=RC[-1],RC[-5],TODAY())"
.NumberFormat = "m/d/yyyy"
End With

'Update Reg Status
Range("J2:J" & lastrowa).FormulaR1C1 = _
"=IF(RC[-8]=RC[-2],RC[-3],CONCATENATE(RC[-3],"" "",TEXT(RC[-6],""mm/dd/yyyy"")))"

'Update Active Tab

'Clear Yesterdays Data From Active Tab
Sheets("Active").Select
Range("B2:D" & lastrowa).Select
Selection.ClearContents

'Update Salon Status
Range("B2:B" & lastrowa).FormulaR1C1 = _
"=VLOOKUP(RC[10],OldData!C[4]:C[8],3,FALSE)"


'Update Registration Status
Range("C2:C" & lastrowa).FormulaR1C1 = _
"=IF(RC[-1]=""DEGRADED"",""DROPPED REGISTRATION"",IF(RC[-1]=""OPERATIONAL"",""REGISTERED"",""CHECK""))"

'Update REG LST UP
With Range("D2:D" & lastrowa)
.FormulaR1C1 = "=VLOOKUP(RC[8],OldData!C[2]:C[6],4,FALSE)"
.NumberFormat = "m/d/yyyy"
End With

'Update BDSFT ST
Range("S2:S" & lastrowa).FormulaR1C1 = _
"=IF(RC[-17]=""DEGRADED"",""CFWD POLLING LINE"",IF(RC[-17]=""OPERATIONAL"","""",""CHECK""))"

'Update Reg Notes
Range("R2:R" & lastrowa).FormulaR1C1 = _
"=VLOOKUP(RC[-6],OldData!C[-12]:C[-8],5,FALSE)"

'Update SPACENET

'Pull Client ID
Sheets("SN").Select
Range("A2:A" & lastrowa).Select
Selection.ClearContents
Range("A2:A" & lastrowc).FormulaR1C1 = "=VALUE(RIGHT(RC[4],5))"

'Update Active Sheet
Sheets("Active").Select

Range("E2:E" & lastrowa).FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-4],SN!C[-4]:C[6],3,FALSE)),"""",VLOOKUP(RC[-4],SN!C[-4]:C[6],3,FALSE))"

Range("F2:F" & lastrowa).FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-5],SN!C[-5]:C[5],10,FALSE)),"""",VLOOKUP(RC[-5],SN!C[-5]:C[5],10,FALSE))"

Range("G2:G" & lastrowa).FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(RC[-6],SN!C[-6]:C[4],11,FALSE)),"""",VLOOKUP(RC[-6],SN!C[-6]:C[4],11,FALSE))"


'Update NMS

'Pull Client ID
Sheets("NMS").Select
Range("A2:A" & lastrowa).Select
Selection.ClearContents
Range("A2:A" & lastrowb).FormulaR1C1 = "=VALUE(RIGHT(RC[1],5))"

'Update Active Sheet
Sheets("Active").Select
Range("H2:H" & lastrowa).FormulaR1C1 = "=VLOOKUP(RC[-7],NMS!C[-7]:C,6,FALSE)"
Range("I2:I" & lastrowa).FormulaR1C1 = "=VLOOKUP(RC[-8],NMS!C[-8]:C[-1],8,FALSE)"

'Remove #N/A
Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False



'Copy/Paste Values Active Tab
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Sort Active Tab
With Sheets("active").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B2:B" & lastrowa) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("C2:C" & lastrowa) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("D2:D" & lastrowa) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("A2:A" & lastrowa) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange Range("A1:AK" & lastrowa)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Hide OldData
Sheets("OldData").Visible = False



'PopUp
MsgBox ("O'Lay")

End Sub

 

[neb255]

i think i know what the issue is. im trying to run the macro from a shape i assigned to the macro, whenever i click on the shape i get the error, but if i run it from the macro's menu it works fine.

any idea why it would be doing that?