I am really close on this code...value copy macro

[jfalcone1]

Ok what I need this is this: if visible cells in a range (ie: c7:j200) have a value of 'X', the the second range (ie:c6:j6) will be copied and transposed onto a new sheet into given columns.

I have not worked out the IF section of the code. (IE: IF visible cells have a value of "X" copy the cell in the second range to the corresponding column) (A for A, B for B, C for C, etc...)

Instead of using the "X" value as a condition of copying, it is just copying "X" into the initial range ( ie: c7:j200) however, I can get the ranges to copy perfectly.


If someone can show me how to modify the code in order to realize "X" as a condition of the code that would be very helpful.


Sub Button83_Click()

ActiveSheet.Unprotect "="

Sheets("Database").Range("C7:J200").SpecialCells(xlCellTypeVisible).Value = ("X")
Range("C6:J6").Copy
Sheets("Output").Range("C604").PasteSpecial Transpose:=True

Sheets("Database").Range("K7:T200").SpecialCells(xlCellTypeVisible).Value = ("X")
Range("K6:T6").Copy
Sheets("Output").Range("D604").PasteSpecial Transpose:=True

Sheets("Database").Range("U7:AE200").SpecialCells(xlCellTypeVisible).Value = ("X")
Range("U6:AE6").Copy
Sheets("Output").Range("E604").PasteSpecial Transpose:=True

ActiveSheet.Protect "="
End Sub



if you did not understand the explanation please tell me so I can clarify. I just dont know how to explain because I am not VBA savvy.

 

[Von Pookie]

This won't really work as-is but should give you a general idea of how the IF statements work.

Sub Button83_Click()

With Sheets("Database")
    .Unprotect "="
    If .Range("C7:J200").SpecialCells(xlVisible) = "X" Then
        .Range("C6:J6").Copy
        Sheets("Output").Range("C604").PasteSpecial Transpose:=True
    End If
    If .Range("K7:T200").SpecialCells(xlVisible) = "X" Then
        .Range("K6:T6").Copy
        Sheets("Output").Range("D604").PasteSpecial Transpose:=True
    End If
    If .Range("U7:AE200").SpecialCells(xlVisible) = "X" Then
        .Range("U6:AE6").Copy
        Sheets("Output").Range("E604").PasteSpecial Transpose:=True
    End If
    .Protect "="
End With

End Sub

That being said: what exactly are you trying to do? Are you wanting to check if there is an X in every cell in that given range and then copy the C6:J6 range?

 

[jfalcone1]

Its more along the lines of, IF there are any cells within the visible column ranges that have a value of 'x' then copy the column header cell from the other range (c6:j6) to a new sheet.


Also, with the code you gave me I get RunTime Error 13: Type Mismatch

 

[jfalcone1]

bmp

 

[Von Pookie]

Also, with the code you gave me I get RunTime Error 13: Type Mismatch

As I said at the start of that post, the code would not work.

Its more along the lines of, IF there are any cells within the visible column ranges that have a value of 'x' then copy the column header cell from the other range (c6:j6) to a new sheet.

For this, you could use a COUNTIF to count the number of 'X' cells in the range.

This is untested, but try:

Sub Button83_Click()
Dim c As Long, k As Long, u As Long

With Sheets("Database")
    .Unprotect "="
    c = Application.WorksheetFunction.CountIf(.Range("C7:J200").SpecialCells(xlVisible) , "X")
    k = Application.WorksheetFunction.CountIf(.Range("K7:T200").SpecialCells(xlVisible), "X")
    u = Application.WorksheetFunction.CountIf(.Range("U7:AE200").SpecialCells(xlVisible), "X")

    If c > 0 Then
        .Range("C6:J6").Copy
        Sheets("Output").Range("C604").PasteSpecial Transpose:=True
    End If
    If k > 0 Then
        .Range("K6:T6").Copy
        Sheets("Output").Range("D604").PasteSpecial Transpose:=True
    End If
    If u > 0 Then
        .Range("U6:AE6").Copy
        Sheets("Output").Range("E604").PasteSpecial Transpose:=True
    End If
    .Protect "="
End With

End Sub

 

[jfalcone1]

that will do it! . I just need to repeat that process for the 30-odd variables that I have and I will be set. Thanks a bunch.

 

[jfalcone1]

is there a way to abbreviate that code so it can apply to a longer range. Instead of having to go through and create a new function for each range?