CODEWITHSUNDEEP
vbaexcelexcel-2007
Jonny
Jonny

Reputation: 619

How to use column headers to select different ranges of cells to populate data from a filename

This is a separate question stemming from this post: How to use the filename of an excel file to change a column of cells?

I noticed that in the last post's code it was referencing specific cells (J2,K2). However when using the code, I came into an error when the columns changed. So now I am seeking a way to modify the below code to use the names of the header columns to populate the 2nd column instead of referencing specific cells. I think the only line that really needs adjusting is the myRng line, but I will provide all the code I am trying for reference.

In case you don't read the other post, I will describe the issue. I am trying to fill in the 2nd column (name+type) based on the "name" column and the filename. When I was referencing the K or J row in the code, everything was working fine, but when I load a different file and the columns positions have changed, everything gets messed up.

I need to populate the 2nd column (name+type) to be the exactly the same number or rows as the 1st column (name) which is why I am using the Range ("K2:K" & lastCell) formula.

Is there a way to do this?

Current Attempted VBA code:

' Insert Column after name and then rename it name+type

Rows(1).Find("name").Offset(0, 1).EntireColumn.Insert
Rows(1).Find("name").Offset(0, 1).FormulaR1C1 = "name+type"

Dim myRng As Range
Dim lastCell As Long
Dim myOtherRange As Range
Dim column2Range As Range

myOtherRange = Rows(1).Find("name")
column2Range = Rows(1).Find("name+type")
lastCell = Range(myOtherRange).End(xlDown).Row
Set myRng = Range("K2:K" & lastCell)

myOtherRange.FormulaR2C1 = "=LEFT(MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1),5)&RC[-1]"
myOtherRange.FormulaR2C1.Select
Selection.Copy
myRng.Select
ActiveSheet.Paste

First Draft VBA code:

' Insert Column after name and then rename it name+type

Rows(1).Find("name").Offset(0, 1).EntireColumn.Insert
Rows(1).Find("name").Offset(0, 1).FormulaR1C1 = "name+type"


'Add the contents to the name+type column

Range("K2").Select
ActiveCell.FormulaR1C1 = "=LEFT(MID(CELL(""filename"",RC[-1]),SEARCH(""["",CELL(""filename"",RC[-1]))+1,SEARCH(""]"",CELL(""filename"",RC[-1]))-SEARCH(""["",CELL(""filename"",RC[-1]))-1),5)&RC[-1]"
Range("K2").Select
Selection.Copy
Range("K2:K8294").Select
ActiveSheet.Paste

Upvotes: 0

Views: 10750

Answers (2)

Jonny
Jonny

Reputation: 619

After modifying the code provided by Siddharth, this is the final code that worked for me. The save feature needed to also remove a format and the Formula to search and add the filename to the cells did not work without this edit. I also had to change the sheet to the activeSheet, because it was constantly changing. Here is the code:

Sub Naming()

Dim LR As Long, i As Long, lngCol As Long

lngCol = Rows(1).Find("NAME", lookat:=xlWhole).Column 'assumes there will always be a column with "NAME" in row 1

Application.ScreenUpdating = False

LR = Cells(Rows.Count, lngCol).End(xlUp).Row

For i = LR To 1 Step -1

    If Len(Cells(i, lngCol).Value) < 4 Then Rows(i).Delete

Next i

Application.ScreenUpdating = True

' Insert Column after NAME and then rename it NAME+TYPE

Dim ws As Worksheet
Dim lRow As Long, aCol As Long
Dim aCell As Range

Set ws = ActiveSheet 'Need to change to the Active sheet

With ws
    Set aCell = .Rows(1).Find("NAME")

    ' Check if the column with "NAME" is found, it is assumed earlier
    If Not aCell Is Nothing Then
        aCol = aCell.Column
        .Columns(aCol + 1).EntireColumn.Insert
        .Cells(1, aCol + 1).Value = "NAME+TYPE"
        .Activate

    ' Freeze the Top Row

    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

        ' Get lastrow of Col which has "NAME"
        lRow = .Range(Split(.Cells(, aCol).Address, "$")(1) & .Rows.Count).End(xlUp).Row

        'Save the file and format the filetype
        Dim wkb As Workbook
        Set wkb = ActiveWorkbook 'change to your workbook reference
        wkb.SaveAs Replace(wkb.Name, "#csv.gz", ""), 52 'change "csv.gz" to ".xlsm" if need be

        ' Add the formula to all the cells in 1 go.
        .Range(Split(.Cells(, aCol + 1).Address, "$")(1) & "2:" & _
        Split(.Cells(, aCol + 1).Address, "$")(1) & lRow).Formula = _
        "=LEFT(MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1),5)&RC[-1]"

        .Columns("A:AK").Columns.AutoFit
    Else
        MsgBox "NAME Column Not Found"
    End If
 End With

' Change the Range of the cursor

Range("A1").Select
Application.CutCopyMode = False


End Sub

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149305

@Scott or Siddharth Rout probably =) – Jonny 11 hours ago

I would never recommend this :) SO is full of experts who can assist you. Why do you want to limit the help that you can get? ;)

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, aCol As Long
    Dim aCell As Range

    Set ws = Sheets("Sheet1") '<~~ Change this to the relevant sheet name

    With ws
        Set aCell = .Rows(1).Find("Name")

        '~~> Check if the column with "name" is found
        If Not aCell Is Nothing Then
            aCol = aCell.Column
            .Columns(aCol + 1).EntireColumn.Insert
            .Cells(1, aCol + 1).Value = "Name+Type"
            .Activate

            .Rows(1).Select

            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With

            '~~> Get lastrow of Col which has "name"
            lRow = .Range(Split(.Cells(, aCol).Address, "$")(1) & .Rows.Count).End(xlUp).Row

            ThisWorkbook.Save

            '~~> Add the formula to all the cells in 1 go.
            .Range(Split(.Cells(, aCol + 1).Address, "$")(1) & "2:" & _
            Split(.Cells(, aCol + 1).Address, "$")(1) & lRow).Formula = _
            "=LEFT(MID(CELL(""filename"",RC[-1]),SEARCH(""["",CELL(""filename"",RC[-1]))+1," & _
            "SEARCH(""]"",CELL(""filename"",RC[-1]))-SEARCH(""["",CELL(""filename"",RC[-1]))-1),5)&RC[-1]"

            .Columns("A:AK").Columns.AutoFit
        Else
            MsgBox "Name Column Not Found"
        End If
     End With
End Sub

Upvotes: 1

Related Questions