CODEWITHSUNDEEP
vbaexcel
Clusks
Clusks

Reputation: 520

Find a column by header name and replace values in column with array items

I've been asked to create a tool that will allow me to replace numerical values with text values using a lookup, the lookup values come from a worksheet ("lookupSheet", for the purpose of this question), and are intended to replace the numerical values in another worksheet ("replaceSheet", for the purpose of this question.) So if 0=dog,1=cat,2=cow,3=sheep And my original column looks like:

NewCol
0
1
2
3
1
0

It should then, after running on the lookup range, look like:

NewCol
Dog
Cat
Cow
Sheep
Cat
Dog

The lookup values are always in the order of their corresponding number, so it is easy to pass this in to an array. However, one issue is that the column header remains the same, but could change in its position within different worksheets, so I've tried to adapt code that worked so it will first find the header by its name ("NewCol", for the purposes of this question), get the column reference, and then apply the loop to change values to this. However, every time I get to the loop in my code, I get an application defined or object defined error, and I'm unsure what it is I'm doing wrong. I put a break point on the "lRow =" line, and after this is when the error occurs.

Sub ChangeCol()

Dim strArray As Variant
Dim TotalRows As Long
Dim replaceSheet As Worksheet
Dim lookupSheet As Worksheet
Dim I As Long
Dim lRow As Long
Dim aCell As Long

    'Set worksheets
    Set lookupSheet = ThisWorkbook.Sheets(1)
    Set replaceSheet = ThisWorkbook.Sheets(2)

    'Load lookupArray
    TotalRows = lookupSheet.Rows(Rows.Count).End(xlUp).Row
    strArray = lookupSheet.Range(Cells(2, 2), Cells(TotalRows, 2)).Value
    MsgBox "Loaded " & UBound(strArray) & " items!"

    'Find column to replace values
    aCell = replaceSheet.Range("A1:DD1").Find(What:="NewCol", LookIn:=xlValues, LookAt:=xlWhole, _
    MatchCase:=False, SearchFormat:=False).Column

    lRow = replaceSheet.Cells(Rows.Count, aCell).End(x1Up).Row

    'Loop through lookup array and replace values
    For I = 1 To UBound(strArray)
        replaceSheet.Columns(aCell).replace What:=(I - 1), Replacement:=strArray(I, 1), LookAt:=xlWhole, MatchCase:=True
    Next I

End Sub

I'm unsure what is going wrong with it, or if there is a better way around this, any help on where I'm going wrong is much appreciated.

Upvotes: 1

Views: 1259

Answers (1)

R3uK
R3uK

Reputation: 14537

As pointed out in comments, you have a typo there : lRow = replaceSheet.Cells(Rows.Count, aCell).End(x1Up).Row it's xLUp change the 1 to l

A few changes to use ranges and avoid using replace with the array to simply put the values as you already have them in the good order :

Sub ChangeCol()

Dim strArray As Variant
Dim TotalRows As Long
Dim replaceSheet As Worksheet
Dim lookupSheet As Worksheet
Dim I As Long
Dim lRow As Long
Dim ColToCopy As Long
Dim MatchedHeader As Range
Dim ZoneToFill As Range

    'Set worksheets
    Set lookupSheet = ThisWorkbook.Sheets(1)
    Set replaceSheet = ThisWorkbook.Sheets(2)

    'Load lookupArray
    ColToCopy = 2
    TotalRows = lookupSheet.Cells(lookupSheet.Rows.Count, ColToCopy).End(xlUp).Row
    strArray = lookupSheet.Range(Cells(2, ColToCopy), Cells(TotalRows, ColToCopy)).Value
    MsgBox "Loaded " & UBound(strArray) & " items!"

    'Find column to replace values
    Set MatchedHeader = replaceSheet.Range("A1:DD1").Find(What:="NewCol", LookIn:=xlValues, LookAt:=xlWhole, _
                        MatchCase:=False, SearchFormat:=False)

    lRow = replaceSheet.Cells(replaceSheet.Rows.Count, MatchedHeader.Column).End(xlUp).Row

    'Resize the range to fit the array and send the values in
    MatchedHeader.Offset(1, 0).Resize(UBound(strArray, 1), UBound(strArray, 2)).Value = strArray

End Sub

Upvotes: 2

Related Questions