Copy code

Brass Contributor

Appreciate if this code shall be corrected or made simpler. Failed while trying to copy the rest of the columns for getting the filter based on the values in Row 1. Row 1 in  worksheet "sections" shall be exactly as row the row 1 in worksheet "Route" ( as the number of columns may vary in the sheet).

While running the code the formula is being displayed in the cells in "sections" which should not be displaying the formula. Please guide how to achieve the same.

 

1 Reply

@Rudrabhadra 

Try this code, please just customize your file, like names and areas.

 

 

Option Explicit

Sub Test()
    Dim wsRoute As Worksheet
    Dim wsSections As Worksheet
    Dim lastColumn As Long
    Dim lastRow As Long
    Dim formula As String

    ' Set references to the worksheets
    Set wsRoute = ThisWorkbook.Worksheets("Cable Route")
    Set wsSections = ThisWorkbook.Worksheets("Sections")

    ' Clear previous formulas and values in Sections sheet
    wsSections.UsedRange.ClearContents

    ' Copy values from Cable Route sheet
    lastColumn = wsRoute.Cells(1, wsRoute.Columns.Count).End(xlToLeft).Column
    wsRoute.Range("A1").Resize(2, lastColumn).Copy Destination:=wsSections.Range("B1")

    ' Determine the last row in Cable Route sheet
    lastRow = wsRoute.Cells(wsRoute.Rows.Count, "A").End(xlUp).Row

    ' Build the formula string for each cell in the range
    formula = "=IF(INDEX('Cable Route'!$C$1:$C$" & lastRow & ",, MATCH('Cable Route'!$A$1, 'Cable Route'!$1:$1, 0)) = $A2, 'Cable Route'!$C$1, """")"

    ' Apply the formula to the range in Sections sheet
    wsSections.Range("B2:EA" & lastRow).Formula = formula

    ' Save the workbook
    ThisWorkbook.Save
End Sub