2

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:

  • Number 4 in Cell L4 would output like this (Apples, Bananas)
  • Number 5 in Cell L5 would output like this (Tomatoes)
  • Number 6 in Cell L6 would output like this (Apples)

Thanks for your help

FreeMan
  • 5,660
  • 1
  • 27
  • 53
Bertsector
  • 223
  • 1
  • 3
  • 15
  • 4
    Welcome to SO! [How to ask a good question](http://stackoverflow.com/help/how-to-ask) will be a great place for you to start. Significantly, this isn't a code-writing service, so you'll need to give it a shot, then we'll be more than happy to help you fix what you've got. – FreeMan Apr 29 '15 at 12:42
  • I've tried with a .Find wasn't successful, I've looked up everywhere and just can't seem to get what I need done – Bertsector Apr 29 '15 at 12:46
  • Maybe something like this I would assume: Dim ws As Worksheet If ws.Range("N3:WI900").Value = 1 Then ActiveCell.Select Selction.Copy Set r = ws.Rows(L) – Bertsector Apr 29 '15 at 12:57
  • 4
    Please see: [Concatenate top row cells if column below has 1](http://stackoverflow.com/questions/28679758/trying-to-concatenate-top-row-cells-if-column-below-has-1-in-excel-2013/28680713#28680713) –  Apr 29 '15 at 13:10

1 Answers1

1

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

Lance
  • 203
  • 2
  • 15