Search code examples
vbaexcelexcel-2013

Offsetting header rows using ListHeaderRows


I have a macro that pulls data from a column in another workbook. Both the source and the target workbooks have variable row counts, and columns in either of them can move around at any point, so the columns are matched based on header names rather than column indexes.

The problem that I'm having is that the header row in my target worksheet keeps getting overwritten by the macro and replaced with the header name from the source worksheet. So for example if the target column is called "Supplier" I don't want it to get overwritten by the source worksheets column that is named "Vendor". I have tried implementing the ListHeaderRows functionality with no success, can anyone tell me what's wrong with this code?

Hint: the header rows begin on row 2, not row 1.

Set g = target_sheet.Rows(2).Find(what:="Supplier", _
                            lookat:=xlWhole, LookIn:=xlValues)

If Not g Is Nothing Then

 Set mainVendorCol = g.EntireColumn
 lHeadersRows = mainVendorCol.ListHeaderRows
 If lheaderrows > 0 Then
    Set mainVendorCol = mainVendorCol.Resize(mainVendorCol.Rows.Count - lHeadersRows)
    Set mainVendorCol = mainVendorCol.Offset(2)
 End If
Set ran = mainVendorCol

For Each c In ran.Cells

    id = c.EntireRow.Cells(3).Value

    If Len(id) > 0 Then

        r = Application.Match(id, srcIdCol, 0)

        If Not IsError(r) Then
            c.Value = Application.Index(srcVendorCol, r, 1)
        Else
            c.Value = "PROJECT NOT FOUND"
        End If
    End If
Next c

End Sub


Solution

  • Here is how I do it. It may seem a little long winded at first but once you're set up there's very little maintenance and you can use it in all your projects.

    I have a Class Module called cColumn:

    Option Explicit
    
    Private msHeader As String
    Private miNumber As Integer
    
    Public Property Get Header() As String
    
        Header = msHeader
    
    End Property
    
    Public Property Let Header(ByVal sHeader As String)
    
        msHeader = sHeader
    
    End Property
    
    Public Property Get Number() As Integer
    
        Number = miNumber
    
    End Property
    
    Public Property Let Number(ByVal iNumber As Integer)
    
        miNumber = iNumber
    
    End Property
    

    I instantiate this class in a procdure:

        Dim colMainInfoColumns As Collection
        Dim avarMainInfoColumnsToFind() As Variant
    
        'this is a list of columns I want to find, you could also use an array:
        avarMainInfoColumnsToFind = ThisWorkbook.Sheets("Columns") _
                .Range("rgnMainInfoColumnsToFind").Value 
    
        Set colMainInfoColumns = ColumnBuilder(wksMainInfo, avarMainInfoColumnsToFind)
    
        If colMainInfoColumns Is Nothing Then Exit Sub
    

    I use this function (you can put this in your class module if you want) to create the collection of columns - this looks at row 1, either amend to row 2 or create a new parameter for the row number.

        Private Function ColumnBuilder(wksToSearch As Worksheet, avarColumnsToFind() As Variant) As Collection
    '---loops a worksheet and creates collection of columns---
    '---collection key = column name without spaces---
    
        Dim colColumns As Collection, clsColumn As cColumn, iIndex As Integer
        Dim iColfound As Integer, sError As String
    
        Set colColumns = New Collection
    
        For iIndex = LBound(avarColumnsToFind, 1) To UBound(avarColumnsToFind, 1)
    
            On Error Resume Next
            iColfound = wksToSearch.Rows(1).Find(what:=avarColumnsToFind(iIndex, 1), lookat:=xlWhole).Column
            On Error GoTo 0
    
            If iColfound > 0 Then
    
                Set clsColumn = New cColumn
                clsColumn.Header = avarColumnsToFind(iIndex, 1)
                clsColumn.Number = iColfound
    
                colColumns.add clsColumn, ConvertStringToKey(avarColumnsToFind(iIndex, 1))
    
            Else
                sError = sError & vbNewLine & avarColumnsToFind(iIndex, 1)
            End If
    
        Next
    
        If sError = "" Then
            Set ColumnBuilder = colColumns
        Else
            Set ColumnBuilder = Nothing
            MsgBox "Unable to process script as the following columns were not found on " & wksToSearch.Name & ":" _
                 & vbNewLine & vbNewLine & sError
        End If
    
    End Function
    
    Private Function ConvertStringToKey(ByVal sKey As Variant)
    
        sKey = Replace(sKey, " ", "")
    
        ConvertStringToKey = sKey
    
    End Function
    

    You can then access your columns by key without spaces, eg:

    Returns col number of the "Tenant Reference" column:

    colMainInfoColumns.Item("TenantReference").Number 
    

    Counts number of populated cells in the "Tenant Referance" column:

    WorksheetFunction.CountA(activesheet.Columns(colMainInfoColumns.Item("TenantReference").Number))