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

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55
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.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
This won't really work as-is but should give you a general idea of how the IF statements work.

Code:
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

Board Regular
Joined
Jul 13, 2007
Messages
55
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
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
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:

Code:
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

Board Regular
Joined
Jul 13, 2007
Messages
55
that will do it! :cool: . I just need to repeat that process for the 30-odd variables that I have and I will be set. Thanks a bunch. :biggrin:
 

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55
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?
 

Forum statistics

Threads
1,181,647
Messages
5,931,210
Members
436,784
Latest member
amuljono

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top