paste range of formulas into xlcelltypevisible rows only (then paste values) EXCEL 2007

[jgamse]

Good afternoon!

I am trying to come up with a way to quickly go through a large range of cells and paste the formulas (and then values over-top) to ONLY the visible rows. I feel like I am missing some small and simple thing that is keeping me from getting this to work. Any suggestions would be appreciated! I looked at manually forcing each cell, but that takes VERY long time. The document is designed to work for as little as 10 rows of data and up to 9000. I know at some point its going to go slow, but I am hopeful I can at least be as efficient as possible! Also, I must continue to use excel 2007 currently.

I am also trying to build this in a fashion so should I need this in a different area (or areas) at a different time. I can just adjust the fmla(copy) & Rng(paste) ranges & re-use the same code.

Sub CopyPasteVisibleRange()
    Application.ScreenUpdating = False
    
    Dim Rng As Range, fmla As Range, lr As Long
    Set fmla = Range("L6:AC6")
    lr = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    
    Set Rng = Range("L7:AC" & lr)
 
    fmla.copy
     
        Rng.SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=False


        Rng.SpecialCells(xlCellTypeVisible).copy
            Rng.SpecialCells(xlCellTypeVisible).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
      
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Thanks for your help!

 

[pbornemeier]

I use this code for that task:

Sub ApplyFormulaToVisibleRows()

    Dim strReturn As String
    Dim varCalendar() As Variant
    Dim intX As Integer
    Dim lngLastDataRow As Long
    
    AutoFilterMode = False
    lngLastDataRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Get unique values from the column that will be used for filtering
    Columns("G:G").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("M1"), Unique:=True
    If Range("M1").CurrentRegion.Cells.Count > 2 Then
        varCalendar = Range("M2:M" & Cells(Rows.Count, 13).End(xlUp).Row).Value
    Else
        ReDim varCalendar(1 To 1, 1 To 1)
        varCalendar(1, 1) = Range("M2").Value   'M1 contains the header
    End If
    
    'Different formulas are selected based on varCalendar using Select Case , only 1 formula is shown here for simplicity
    
    'Improved WORKDAYS - can exclude different days and account for holidays 1=Sun, 7=Sat
    'A1=Start  B1=Finish   'Holidays' is named range containing dates not to be counted
    '=SUMPRODUCT(ISNUMBER(MATCH(WEEKDAY(ROW(INDIRECT(A1 & ":" & B1))),{2,3,4,5,6},0))*ISNA(MATCH(ROW(INDIRECT(A1 & ":" & B1)),Holidays,0)))
    strReturn = "=SUMPRODUCT(ISNUMBER(MATCH(WEEKDAY(ROW(INDIRECT(RC5 & "":"" & RC6))),{2,3,4,5,6},0))*ISNA(MATCH(ROW(INDIRECT(RC5 & "":"" & RC6)),Holidays,0)))"
    
    'Rows are filtered based on based on varCalendar
    Range("A1").CurrentRegion.AutoFilter Field:=7, Criteria1:=varCalendar(intX, 1)
    
    Range("I2:I" & lngLastDataRow).Select
    Application.Calculation = xlCalculationManual
    With Selection
        .SpecialCells(xlCellTypeVisible).FormulaR1C1 = strReturn    'strReturn formula is applied to visible rows
        Application.Calculate
        
        'I did not use to bother with next 3 lines, but I found with large row counts (>200K) some cells at the bottom
        '    would be forced to a value before the calculated and therefore incorrectly return a 0,
        While Application.CalculationState = xlCalculating
            DoEvents
        Wend
        
        .Value = .Value
    End With

End Sub

Let me know how it works for you.