CODEWITHSUNDEEP
vbaexcel
Bertsector
Bertsector

Reputation: 223

Excel VBA Find data that is not equal to 0 and copy Row header

I have a spreadsheet that I would need to create a macro for and I need you guys help.

The big picture, I want to find a cell in a range that is not equal to 0 (Its either 0 or 1 in that cell range) And copy the title of that column and paste it in the L Cell of the same row it found the 1.

So it goes like this:

Row N2 to WI2 has the titles of the columns, Range N3 to WI9000 is the location of the cells with either 1 or 0 --- 1 if the value exist and 0 if its not found

EX:

3   Apples Bananas Tomatoes
4        1       1        0
5        0       0        1
6        1       0        0

And when it sees the 1's or not equal to 0:

Thanks for your help

Upvotes: 2

Views: 1822

Answers (1)

Lance
Lance

Reputation: 203

Do it old school like this ↓↓↓ or use range.findnext(previousfind) 

Sub FruitSorter()
        Dim xrow As Long
        Dim xcolumn As Long
        Dim lastcolumn As Long
        'dont forget to use cleaner - (desired)range.ClearContents before running this
        xrow = 4 'seen in example edit this
        xcolumn = 1 'seen in example edit this
        lastcolumn = 4 'your last column where you want the fruit to be written into

        Do 'loop for rows
            Do 'loop for columns
                Select Case Cells(xrow, xcolumn).Value 'checks if cell contains 1
                    Case 1 'if one do below
                        If Cells(xrow, lastcolumn) = "" Then 'if it is first time the cell is modified then
                            Cells(xrow, lastcolumn) = Cells(3, xcolumn).Value 'write data
                        Else 'if the cell already contains fruit then
                            Cells(xrow, lastcolumn) = Cells(xrow, lastcolumn) & ", " & Cells(3, xcolumn).Value 'insert value thet already is in the cell plus the new one
                        End If
                    Case 0 'nothing happens
                End Select
                xrow = xrow + 1 'move one row forward
            Loop Until Cells(xrow, xcolumn) = "" 'will loop until cell under your table is empty you can set any other specified condition like row number(until xrow=200)
            xcolumn = xcolumn + 1  'move one column forward
            xrow = 4 'move back to the beginning
        Loop Until xcolumn = lastcolumn 'will loop until xcolumn reaches the last column where fruit is being written
    End Sub

Hope this helps

Upvotes: 1

Related Questions