Filter and Fill visible cells with formula VBA

Question

I was wondering if there is a way of going through a filter list. for each filtered list I will perform a formula. i.e

Company Name             Invoice Number              Voucher Number
CompanyA                 000001                      TX100
CompanyA                 000001                      //copy what's on top
CompanyA                 000001                     //copy what's on top
CompanyB                 000002
CompanyB                 000002
CompanyC                 000003                     TY909
CompanyC                 000003                     //copy what's on top

Basically I need to filter the column company name(Range A filter) as you can notice for each company name some rows of voucher rows values are missing I just need to fill it with the same voucher number so it'll be like ...

Company Name             Invoice Number              Voucher Number
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyB                 000002
    CompanyB                 000002
    CompanyC                 000003                     TY909
    CompanyC                 000003                     TY909

I want output to be like that notice I don't need to fill for those that doesn't have voucher number i.e CompanyB

I've tried this code without filtering each company ...

Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Formula = "=IF(J2<>"""",J2,IF(V1="""","""",V1))"
Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Value = Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Value
Range("V1:V" & xRow).SpecialCells(xlCellTypeVisible).Copy
Range("J1").PasteSpecial Paste:=xlPasteValues

the dilemma is it copies everything on top of if so it'll be like

Company Name             Invoice Number              Voucher Number
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyA                 000001                      TX100
    CompanyB                 000002                      TX100
    CompanyB                 000002                      TX100
    CompanyC                 000003                     TY909
    CompanyC                 000003                     TY909

which is wrong. any help? or improvements.

Update: I've tried using filter

Sub try()
Dim currRng As Range, dataRng As Range, currCell As Range
Dim xRow As Long
xRow = Cells(rows.Count, "A").End(xlUp).row
With ActiveSheet
        Set currRng = .Range("A1", .Cells(.rows.Count, "A").End(xlUp))
        Set dataRng = .Range("V2:V" & xRow)
       ' Range("AF:XFD").Delete
        With .UsedRange
            With .Resize(1, 1).Offset(, .Columns.Count)
                With .Resize(currRng.rows.Count)
                    .Value = currRng.Value
                    .RemoveDuplicates Array(1), Header:=xlYes
                    For Each currCell In .SpecialCells(xlCellTypeConstants)
                        currRng.AutoFilter field:=1, Criteria1:=currCell.Value
                        If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
                            dataRng.Value = Range("I2").Value
                            dataRng.SpecialCells(xlCellTypeVisible).Formula = "=IF(I2<>"""",I2,IF(V2="""","""",V2))"
                            dataRng.Value = dataRng.Value
                            dataRng.Copy Destination:=Range("I2")
                            dataRng.ClearContents
                        End If
                       Next currCell
                    .ClearContents
                End With
            End With
        End With
        .AutoFilterMode = False
    End With
End Sub

range("V:V") is where I'm storing/dumping my formula, Range("I:I") is the column range where Voucher number is stored, but I still get no result or null. I need to filter every company and from that company if the first row result of that company is null make it all null (say in CompanyB in my sample) and if it does have a value (like my sample ng CompanyA and CompanyC) fill those down.

Answer 1

The below code helps to Copy and paste the formulas in visible cells only. Its working fine for me. You can put any other formulas too.

    Dim Xrow As Long, WS As Worksheet, dng As Range
    Xrow = Cells(Rows.Count, "A").End(xlUp).Row
    With ActiveSheet
        Set WS = ActiveSheet
        Set dng = .Range("H1:H" & Xrow)
        WS.Range("A1:BD1" & Xrow).AutoFilter Field:=12, Criteria1:="Sheets"
        Range("H1").Select
        dng.SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=RC[1]"
    End With

    'To remove Autofilter
    ActiveSheet.ShowAllData

    'To copy and paste special values for columns use the below
    Columns.EntireColumn("H").Copy
    Columns.EntireColumn("H").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub

Answer 2

Upon trying several times I've come up with this code...

Sub voucher_num()
Dim cell As Range, currRng As Range, dataRng As Range, currCell As Range, destRng As Range
Dim xRow As Long
xRow = Cells(rows.Count, "A").End(xlUp).row
With ActiveSheet
        Set currRng = .Range("A1", .Cells(.rows.Count, "").End(xlUp)) 'column range of my filter
        Set dataRng = .Range("V2:V" & xRow) 'range of column I'm dumping my formula
        Set destRng = .Range("I2:I" & xRow) 'storing again the values I've come up with from the formula

        With .UsedRange
            With .Resize(1, 1).Offset(, .Columns.Count)
                With .Resize(currRng.rows.Count)
                    .Value = currRng.Value
                    '.RemoveDuplicates Array(1), Header:=xlYes
                For Each currCell In .SpecialCells(xlCellTypeConstants)

                currRng.AutoFilter Field:=1, Criteria1:=currCell.Value

                If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
                    dataRng.SpecialCells(xlCellTypeVisible).Value = destRng.SpecialCells(xlCellTypeVisible).Value
                    dataRng.SpecialCells(xlCellTypeVisible).FillDown
                    dataRng.SpecialCells(xlCellTypeVisible).Value = dataRng.SpecialCells(xlCellTypeVisible).Value
                    dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=destRng.SpecialCells(xlCellTypeVisible)
                    dataRng.SpecialCells(xlCellTypeVisible).ClearContents
                End If

        Next currCell
    .ClearContents
            End With
        End With
    End With
    .AutoFilterMode = False
End With
End Sub

This takes quite your time, I haven't come up with a better/faster approach but this is doing what I want.

Answer 3

edited after OP's clarifications about data placement:

you may use this

Range("V2:V" & xRow).SpecialCells(xlCellTypeVisible).Formula =IF(I2<>"""",I2,IF(A2<>A1,"""",IF(U1="""","""",U1)))