VBA Loop through Range copy paste values on another sheet

[pthomas416]

I am trying to write VBA to look through a range I have titled "Programs" which runs from column BH2:DY39. I am trying to write a macro that will look through each record of 37 project codes and look for a Y in the row. If there is a Y, then I need the macro to copy the project code from coumn H (no included in the "Programs" range currenlty) and copy the header in the table above where the Y is located and paste both side by side on a new sheet. I need it to loop through all the columns looking for Y and doing the same thing, then to start with the next row.

I'm lost on where to start with this, but I'm hoping someone here can help point me in the right direction.

thanks so much!

 

[mumps]

What do you mean by "application piece"? Are you saying that it is copying the project code but not copying the column header?

 

[pthomas416]

Yes, that is correct.

What do you mean by "application piece"? Are you saying that it is copying the project code but not copying the column header?

 

[mumps]

Did the macro work properly before? If so, has the data changed in any way? Are you getting an error message? Is so, what is the error and which line of code is highlighted when you click 'Debug'?

 

[pthomas416]

No change in the data and no error message when it's run. The headers are the still in the same row down from the bottom and in the same column locations. No error so no debug message.

 

[mumps]

It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[pthomas416]

Mumps, I actually figured out the answer on this one! However, I do have another quesiton. If I wanted to look for multiple values other than the "Y", how would I do that? Specifically looking for "g", "y", "r", or "0". I would also want to see if I could return the that value in another column. so for example my results on the destination sheet would be - Project , Month , Value (g, y, r, or 0) as my three columns. Thank you as always for so much help!

It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[mumps]

Try: (Untested)

Sub CopyVals()
    Application.ScreenUpdating = False
    Dim bottomDY As Long
    bottomDY = Range("DY" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim foundVal As Range
    Dim sAddr As String
    Dim valArray As Variant
    valArray = Array("g", "y", "r", "O")
    Dim i As Long, x As Long
    Sheets("Sheet2").UsedRange.ClearContents
    For i = LBound(valArray) To UBound(valArray)
        For x = 2 To bottomDY
            Set foundVal = Range("BH" & x & ":DY" & x).Find(valArray(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not foundVal Is Nothing Then
                sAddr = foundVal.Address
                Do
                    Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Range("H" & x)
                    Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = Cells(1, foundVal.Column)
                    Sheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) = valArray(i)
                    Set foundVal = Range("BH" & x & ":DY" & x).FindNext(foundVal)
                Loop While foundVal.Address <> sAddr
                sAddr = ""
            End If
        Next x
    Next i
    Application.ScreenUpdating = True
End Sub

I wasn't sure if one of the values was a zero or a capital "O". I used the capital "O". Change it to a zero if necessary.