Forum Discussion

Rudrabhadra's avatar
Rudrabhadra
Brass Contributor
Jul 10, 2023

Copy code

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.

 

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    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

     

     

Resources