CODEWITHSUNDEEP
excelvba
user7419135
user7419135

Reputation:

Add Row Based on Sheet Name

I'm a little stuck at the moment on the problem - I have a workaround but it's very inefficient and also very time consuming to code.

I have a selection of worksheets and I would like to add a different header row to each of these sheets based on the sheet name.

I would like to have a worksheet containing a selection of header rows - see Selection of Header Rows

Then, for example, if the worksheets = A00 - apply the copy in the corresponding Header Row from the Selection worksheet.

This is my current solution - as you can see it is very inefficient and time-consuming

For Each myWorksheet In Worksheets
    If myWorksheet.Name = "A00" Then
        Sheets("A00").Cells(1).Resize(1, 5).Value = Array("ORGANISATION_ID", "FILE_TYPE", "CREATION_DATE", "CREATION_TIME", "GENERATION_NUMBER")
    End If
    If myWorksheet.Name = "Z99" Then
        Sheets("Z99").Cells(1).Resize(1, 1).Value = Array("RECORD_COUNT")
    End If
    If myWorksheet.Name = "I56" Then
        Sheets("I56").Cells(1).Resize(1, 26).Value = Array("ORGANISATION_SHORT_CODE", "INVOICE_NUMBER", "INVOICE_TYPE_CODE", "BILLING_YEAR", "BILLING_MONTH", "INVOICE_AMOUNT", "INVOICE_VAT_AMOUNT", "INVOICE_GROSS_TOTAL", "PAYMENT_DUE_DATE", "VAT_CHARGED_TO_NWO", "VAT_CHARGED_TO_SHIPPER", "INVOICE_TAX_POINT_DATE", "NWO_VAT_ REGISTRATION_NUMBER", "NWO_BANK_SORT_CODE", "NWO_BANK_ACCOUNT_NUMBER", "NWO_BANK_ACCOUNT_NAME", "ISH_VAT_REGISTRATION_NUMBER", "ISH_BANK_ACCOUNT_NUMBER", "ISH_BANK_SORT_CODE", "NWO_SHORT_CODE", "NWO_VAT_REGISTRATION_NAME", "NWO_ADDRESS_LINE_1", "NWO_ADDRESS_LINE_2", "NWO_ADDRESS_LINE_3", "NWO_ADDRESS_LINE_4", "FILE_NAME")
    End If
    If myWorksheet.Name = "I05" Then
        Sheets("I05").Cells(1).Resize(1, 2).Value = Array("ISC_LINE_1_TEXT", "ISC_LINE_2_TEXT")
    End If
    If myWorksheet.Name = "I57" Then
        Sheets("I57").Cells(1).Resize(1, 8).Value = Array("INVOICE_ITEM_REFERENCE_NUMBER", "INCURRED_DATE", "CHARGE TYPE CODE", "QUANTITY", "UNIT_TYPE", "RATE", "INVOICE_ITEM_AMOUNT", "ANCILLARY_INVOICE_COMMENTS")
    End If
    If myWorksheet.Name = "K12" Then
        Sheets("K12").Cells(1).Resize(1, 4).Value = Array("GAS_ACT_OWNER", "CURRENT_METER_ASSET_MANAGER", "PROSPECTIVE_METER_ASSET_MANAGER", "PROSPECTIVE_MAM_EFFECTIVE_DATE")
    End If
Next myWorksheet

Any help with this would be much appreciated.

Upvotes: 1

Views: 774

Answers (2)

CLR
CLR

Reputation: 12279

Create a worksheet called Index and populate it as you have done in the image.

Then, the following code will work through each tab and if the tab name is found in column A it will copy the entire row below that cell into the first row of the tab.

For Each myworksheet In Worksheets
    rowfound = Application.Match(myworksheet.Name, Worksheets("Index").Range("A:A"), 0)
    If Not (IsError(rowfound)) Then myworksheet.Range("1:1").Value = Worksheets("index").Cells(rowfound + 1, 1).EntireRow.Value
Next

Upvotes: 1

Scott H
Scott H

Reputation: 33

I think I would approach this by doing the steps listed below, with the following assumptions about your worksheets.

  • The worksheet in your image is named "Selection of Header Rows".
  • The worksheet in your image will have empty rows between the header listings as pictured.
  • The first column pictured in your image is Column A.
  • You want the headers to start in Cell A1 of the individual sheets.

Steps

  1. Define a range of the pictured worksheet in which we'll search for each worksheet's name.
  2. Loop through each worksheet in the collection, finding its name in our search range.
  3. If the name is found, define a range by using the CurrentRegion property of the range in which the name was found. (The current region is a range bounded by any combination of blank rows and blank columns.)
  4. Count the columns in that range.
  5. Offset that range down one row (to exclude the sheet name itself).
  6. Resize that range to be one row "high" and the same number of columns "wide".
  7. Set the header range on the target sheet to be the cell A1 and resize it to have the correct number of columns.
  8. Set the value of that header range equal to the value of the range we built on the "Selection of Header Rows" worksheet.

    Dim myWorksheet As Worksheet

    Dim searchRange As Range
    Set searchRange = Worksheets("Selection of Header Rows").Range("A:A")

    Dim foundRange As Range
    Dim headerRange As Range
    For Each myWorksheet In Worksheets

        Set foundRange = searchRange.Find(What:=myWorksheet.Name, LookAt:=xlWhole)

        If Not foundRange Is Nothing Then

            Set headerRange = foundRange.CurrentRegion.Offset(1, 0)

            Dim headerColumnCount As Long
            headerColumnCount = headerRange.Columns.Count

            Set headerRange = headerRange.Resize(1, headerColumnCount)

            myWorksheet.Range("A1").Resize(1, headerColumnCount).value = headerRange.value

        End If

    Next myWorksheet

Upvotes: 0

Related Questions