Loop through Columns and Change Row Values to be of the respective Column

[ShuStar]

Hi all,

The Ask: For each column, starting from D3 to n number of Columns, replace the values of Y in each row reflect that of the column header.
ie if D3 Column header is Banana and D4 has Y, then it should replace D4 to be Banana, but dynamically do this as the number of Columns and Rows always change (ie can sometimes be 4 or 10 columns, and rows can be 5-100+ rows)


Current view:

ID	Name	Count	Banana	Apples	Nectarine	....to nColumn
12345	John	1	Y
12345	Sara	4	Y	Y	Y	Y
12345	Alex	3	Y	Y		Y
...to nRow	###	###	###	###	###	###

Sub to amend to:

ID	Name	Count	Banana	Apples	Nectarine	...to nColumn
12345	John	1	Banana
12345	Sara	4	Banana	Apples	Nectarine	...to nColumn
12345	Alex	4	Banana	Apples		...to nColumn
...to nRow	###	###	###	###	###	###

My code where I can't seem to get passed Range(startcolumn, "D"&lastrow).select as it keeps erroring out here.

Any help to resolve this would be greatly appreciated (ie how the code should dynamically scan each column, do a find and replace if the value contains Y to reflect that of the Column name, and then move onto the next column and do the same).

Sub changeYtorespectiveColumnName()



Dim lastrow As Long

Dim lastcolumn As Long

Dim startcolumn As Variant

Dim startingRange As Range

Dim InbtColumn As Long

Dim selectrange As Long

Dim i As Integer



Dim sht As Worksheet



Set sht = Sheets("Matrix")



lastrow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row - 1

lastcolumn = sht.Cells.SpecialCells(xlCellTypeLastCell).Column

startcolumn = Cells(3, 4).Range

Range(startcolumn, "D" & lastrow).Select

startingRange.Select



'For each column

For j = 1 To lastcolumn



'scan through each row and if the value equals Y, then replace it with the title of the column header

For i = 1 To lastrow





Next i



Next j







End Sub

 

[JLGWhiz]

Sub t()
Dim rng As Range, c As Range
Set rng = Range("D1", Cells(Columns.Count).End(xlToLeft))
For Each c In rng
Columns(c.Column).Replace "Y", c.Value
Next
End Sub

 

[ShuStar]

Thank you for your reply but this hasn't worked. It just cleared everything in Column D and did not move onto Column E.

I did also change D1 to D2 in your code (of which Col D2 is the Column Header in my sheet) but again, this just cleared all the rows in Col D and Col E remained as Ys

 

[ShuStar]

Ahh but when I change your code .EndxltoLeft to .EndxlRight, then it the loop is working - but it replace Y to blank, rather than the value of the Column Name.

To Clarify
My Headers are in Row 2
The first column that it should begin this looping find&replace is Col D onwards

Example D2 column name is Banana, if D3 is marked as Y, then this Y should become Banana, and do this find&replace until the end of that column. Then go on to Column E and do the same. thereafter Column F through to nColumn

 

[ShuStar]

Anyone know how i can fix this code so it can change to below (provided by JLGWhiz - thank you!!)? I think it's 90% there, just instead of the VBA removing the Y and replacing it with blanks, I'd like to amend to code to instead replace the Y with the respective Column Header. It is looping through the right amount columns correctly though - just places blanks each time unfortunately.

Sub t()
Dim Rng As Range, c As Range
Set Rng = Range("D2", Cells(Columns.Count).End(xlToRight))
For Each c In Rng
Columns(c.Column).Replace "Y", c.Value


Next
End Sub

My Headers are in Row 2
The first column that it should begin this looping find&replace is Col D onwards

Example D2 column name is Banana, if D3 is marked as Y, then this Y should become Banana, and do this find&replace until the end of that column. Then go on to Column E and do the same. thereafter Column F through to nColumn

Current view:

ID	Name	Count	Banana	Apples	Nectarine	....to nColumn
12345	John	1	Y
12345	Sara	4	Y	Y	Y	Y
12345	Alex	3	Y	Y		Y
...to nRow	###	###	###	###	###	###

Sub to amend to:

ID	Name	Count	Banana	Apples	Nectarine	...to nColumn
12345	John	1	Banana
12345	Sara	4	Banana	Apples	Nectarine	...to nColumn
12345	Alex	4	Banana	Apples		...to nColumn
...to nRow	###	###	###	###	###	###

 

[Spyros13]

I swear You Can do this with a Vlookup or a hlookup or even a countif.you don't need a macro. But I'm lying in my bed. Work in 6 hours.

& What's wrong with just =if(isblank(b$2),"",b$2) .. etc for each row/ cell in your table range ??.

 

[Spyros13]

I meant , (on a new sheet, sheet2) do =if(isblank(Sheet1!d4),"",sheet1!d$2) .. Drag down & across.
& Then Copy them over when your ready ?

You could fill your entire table that way , and it would update when if change y's .

I should be asleap.

 

[jolivanes]

Try

Sub Maybe()
Dim lr As Long, lc As Long, i As Long
lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    For i = 4 To lc
        Columns(i).Replace "Y", Cells(2, i), xlWhole
    Next i
End Sub

 

[JLGWhiz]

@jolivanes has a more universal code but for clarification, here is a mod to my original with the typo fixed.

Sub t()
Dim rng As Range, c As Range
Set rng = Range("D2", Cells(2, Columns.Count).End(xlToLeft))
    For Each c In rng
        Columns(c.Column).Replace "Y", c.Value
    Next
End Sub

 

[ShuStar]

Thank you all. @jolivanes - yours has worked perfectly!! It's exactly the way I was thinking it but couldn't piece it together, brilliant, thank you.

Ahah Spyros13, your comment made me laugh....Re using formula/lookup - dont want the sheet to be formula intensive or creating another tab (along with the many existing tabs) - good shout though.

Thank you all for your support