VBA: Fill formula down column

[CarolynS]

Hi I have a data set where i need to filter on 2 criteria and then perform a simple calculation for the remaining records to show the numberof days between 2 dates. I had previously been looping through cells with an if statement to do this but it seems to slow down the code so I'd like to try a different way.

The first part of my code works fine as it's using the same dates all the way down the column:

    ColRef = WS.UsedRange.Find(What:="Certification - Status", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
    ColRef2 = WS.UsedRange.Find(What:="Person - Start Date", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
    ColRef3 = WS.UsedRange.Find(What:="Days Overdue", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Column
    
    dDate = DateSerial(2012, 5, 21)
    lDate = dDate
    
    With WS.UsedRange
        .AutoFilter field:=ColRef, Criteria1:="=Not Yet Complete"
        .AutoFilter field:=ColRef2, Criteria1:="<" & lDate
    End With
    
    RwLast = WS.Cells(Rows.Count, 1).End(xlUp).Row
    
    WS.Cells(2, ColRef3).Resize(RwLast - 1).Value = DateDiff("d", lDate, Date)
    
    WS.ShowAllData

However, I'm struglling with the 2nd part where I need tofind the number of days between todays date and the cell to the left of the cell my calculation is in. I have the following code but it's giving an "applpication defined or object defined" error. The line .FormulaR1C1 = "= today()- RC[,-1]" seems to be wrong but I'm not sure of the correct way to write it.

    With WS.UsedRange
        .AutoFilter field:=ColRef, Criteria1:="=Not Yet Complete"
        .AutoFilter field:=ColRef2, Criteria1:=">=" & lDate
    End With
    
    RwLast = WS.Cells(Rows.Count, 1).End(xlUp).Row
    
   With WS.Cells(2, ColRef3).Resize(RwLast - 1)
    .FormulaR1C1 = "= today()- RC[,-1]"
    .FillDown
    .Value = .Value
    End With

Also, is this way of writing the code more efficient than looping? or is there a better way?

thanks

 

[CarolynS]

I have now amended part of the code (see below) and the formula is now being populated in the required column. However, when i get to the line .value=.value (i'm trying to remove the formula and just leave the values in place) most of the values dissapear and the cells become blank. If i scroll down the column though there appear to be some values showing at (what looks like) random intervals. I've got no idea why this is happening. I'm using very similar code in another workbook and it works fine

With WS.Cells(2, ColRef3).Resize(RwLast - 1)
.FormulaR1C1 = "=today()- RC[2]"
.FillDown
.Value = .Value
End With

 

[JackDanIce]

It may be because you've turned calculation mode to manual so the values aren't updating prior to hardcoding and have you tried removing .FillDown, it doesn't seem necessary there. Try:

With WS.Cells(2, ColRef3).Resize(RwLast - 1)
  .FormulaR1C1 = "=TODAY()-RC[2]"
  .Calculate
  .Value = .Value
End With

 

[CarolynS]

Hi Thanks for your reply. I've just tried yur suggestion but the same thing is happening and calculation mode is set to automatic. The values are all showing but then they just dissapear at .value=.value. Could it be something to do with the data being filtered and thereofre isn't a continuos selection?

 

[JackDanIce]

Missed part of filtered rows, untested, but try:

With ws.Cells(2, ColRef3).Resize(RwLast - 1)
  .FormulaR1C1 = "=TODAY()-RC[2]"
  .Calculate
  .SpecialCells(xlCellTypeVisible).Value = .SpecialCells(xlCellTypeVisible).Value
End With

 

[CarolynS]

Thanks. Just tried it and all cells stay populated but value in every cell changes to 405. That was the value in the 1st cell in the selection. The rest of the cells should all be different values

 

[CarolynS]

I'm stepping through the code and can see all the cells update with the formula and display correct values but then they all changed to 405 when i got to .SpecialCells(xlCellTypeVisible).Value = .SpecialCells(xlCellTypeVisible).Value

 

[JackDanIce]

I'm not sure, maybe try a simple copy and paste?

With ws.Cells(2, ColRef3).Resize(RwLast - 1)
  .FormulaR1C1 = "=TODAY()-RC[2]"
  .Calculate
  .Copy
  .PasteSpecial xlPasteValues
End With

 

[CarolynS]

It won't paste because the column is filtered but I think i'll just take the filter off and copy and paste special the whole column. Looking on google it seems that everyone is looping through cells to do the same thing but i just find this so slow. Thank you for your help

 

[JackDanIce]

Good luck finding a solution.