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" sha...
Macros and VBA
NikolinoDE's avatar
NikolinoDE
Platinum Contributor
Jul 10, 2023

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