Simplifying this code and adding IF NOT clause

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55
I apologize for not using the HTML Maker but I am at work and the security settings do not let it function.


1. Is there an effective way to simplify this code?
2. As of right now the code will copy the cells perfectly when every source cell is visible. However, when I filter or group source cells the macro breaks down. How can I add an IF NOT visible then Ignore function to this code.


Sub Button85_Click()
Dim c As Long, d As Long, e As Long, f As Long, g As Long, h As Long, i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, s As Long, t As Long, u As Long, v As Long, w As Long, x As Long, y As Long, z As Long, aa As Long, ab As Long, ac As Long, ad As Long, ae As Long

With Sheets("Database")
.Unprotect "COMPS"
c = Application.WorksheetFunction.CountIf(.Range("C7:C200").SpecialCells(xlVisible), "X")
d = Application.WorksheetFunction.CountIf(.Range("D7:D200").SpecialCells(xlVisible), "X")
e = Application.WorksheetFunction.CountIf(.Range("E7:E200").SpecialCells(xlVisible), "X")
f = Application.WorksheetFunction.CountIf(.Range("F7:F200").SpecialCells(xlVisible), "X")
g = Application.WorksheetFunction.CountIf(.Range("G7:g200").SpecialCells(xlVisible), "X")
h = Application.WorksheetFunction.CountIf(.Range("h7:h200").SpecialCells(xlVisible), "X")
i = Application.WorksheetFunction.CountIf(.Range("i7:i200").SpecialCells(xlVisible), "X")
j = Application.WorksheetFunction.CountIf(.Range("j7:j200").SpecialCells(xlVisible), "X")
k = Application.WorksheetFunction.CountIf(.Range("k7:k200").SpecialCells(xlVisible), "X")
l = Application.WorksheetFunction.CountIf(.Range("l7:l200").SpecialCells(xlVisible), "X")
m = Application.WorksheetFunction.CountIf(.Range("m7:m200").SpecialCells(xlVisible), "X")
n = Application.WorksheetFunction.CountIf(.Range("n7:n200").SpecialCells(xlVisible), "X")
o = Application.WorksheetFunction.CountIf(.Range("o7:eek:200").SpecialCells(xlVisible), "X")
p = Application.WorksheetFunction.CountIf(.Range("p7:p200").SpecialCells(xlVisible), "X")
q = Application.WorksheetFunction.CountIf(.Range("q7:q200").SpecialCells(xlVisible), "X")
r = Application.WorksheetFunction.CountIf(.Range("r7:r200").SpecialCells(xlVisible), "X")
s = Application.WorksheetFunction.CountIf(.Range("s7:s200").SpecialCells(xlVisible), "X")
t = Application.WorksheetFunction.CountIf(.Range("t7:t200").SpecialCells(xlVisible), "X")
u = Application.WorksheetFunction.CountIf(.Range("u7:u200").SpecialCells(xlVisible), "X")
v = Application.WorksheetFunction.CountIf(.Range("v7:v200").SpecialCells(xlVisible), "X")
w = Application.WorksheetFunction.CountIf(.Range("w7:w200").SpecialCells(xlVisible), "X")
x = Application.WorksheetFunction.CountIf(.Range("x7:x200").SpecialCells(xlVisible), "X")
y = Application.WorksheetFunction.CountIf(.Range("y7:y200").SpecialCells(xlVisible), "X")
z = Application.WorksheetFunction.CountIf(.Range("z7:z200").SpecialCells(xlVisible), "X")
aa = Application.WorksheetFunction.CountIf(.Range("aa7:aa200").SpecialCells(xlVisible), "X")
ab = Application.WorksheetFunction.CountIf(.Range("ab7:ab200").SpecialCells(xlVisible), "X")
ac = Application.WorksheetFunction.CountIf(.Range("ac7:ac200").SpecialCells(xlVisible), "X")
ad = Application.WorksheetFunction.CountIf(.Range("ad7:ad200").SpecialCells(xlVisible), "X")
ae = Application.WorksheetFunction.CountIf(.Range("ae7:ae200").SpecialCells(xlVisible), "X")

If c > 0 Then
.Range("c6").Copy
Sheets("Output").Range("C504").PasteSpecial Transpose:=True
End If
If d > 0 Then
.Range("d6").Copy
Sheets("Output").Range("C505").PasteSpecial Transpose:=True
End If
If e > 0 Then
.Range("e6").Copy
Sheets("Output").Range("C506").PasteSpecial Transpose:=True
End If
If f > 0 Then
.Range("f6").Copy
Sheets("Output").Range("C507").PasteSpecial Transpose:=True
End If
If g > 0 Then
.Range("g6").Copy
Sheets("Output").Range("C508").PasteSpecial Transpose:=True
End If
If h > 0 Then
.Range("h6").Copy
Sheets("Output").Range("C509").PasteSpecial Transpose:=True
End If
If i > 0 Then
.Range("i6").Copy
Sheets("Output").Range("C510").PasteSpecial Transpose:=True
End If
If j > 0 Then
.Range("j6").Copy
Sheets("Output").Range("C503").PasteSpecial Transpose:=True
End If
If k > 0 Then
.Range("K6").Copy
Sheets("Output").Range("D504").PasteSpecial Transpose:=True
End If
If l > 0 Then
.Range("l6").Copy
Sheets("Output").Range("D505").PasteSpecial Transpose:=True
End If
If m > 0 Then
.Range("m6").Copy
Sheets("Output").Range("D506").PasteSpecial Transpose:=True
End If
If n > 0 Then
.Range("n6").Copy
Sheets("Output").Range("D507").PasteSpecial Transpose:=True
End If
If o > 0 Then
.Range("o6").Copy
Sheets("Output").Range("D508").PasteSpecial Transpose:=True
End If
If p > 0 Then
.Range("p6").Copy
Sheets("Output").Range("D509").PasteSpecial Transpose:=True
End If
If q > 0 Then
.Range("q6").Copy
Sheets("Output").Range("D510").PasteSpecial Transpose:=True
End If
If r > 0 Then
.Range("r6").Copy
Sheets("Output").Range("D511").PasteSpecial Transpose:=True
End If
If s > 0 Then
.Range("s6").Copy
Sheets("Output").Range("D512").PasteSpecial Transpose:=True
End If
If t > 0 Then
.Range("t6").Copy
Sheets("Output").Range("D503").PasteSpecial Transpose:=True
End If
If u > 0 Then
.Range("U6").Copy
Sheets("Output").Range("E504").PasteSpecial Transpose:=True
End If
If v > 0 Then
.Range("v6").Copy
Sheets("Output").Range("E505").PasteSpecial Transpose:=True
End If
If w > 0 Then
.Range("w6").Copy
Sheets("Output").Range("E506").PasteSpecial Transpose:=True
End If
If x > 0 Then
.Range("x6").Copy
Sheets("Output").Range("E507").PasteSpecial Transpose:=True
End If
If y > 0 Then
.Range("y6").Copy
Sheets("Output").Range("E508").PasteSpecial Transpose:=True
End If
If z > 0 Then
.Range("z6").Copy
Sheets("Output").Range("E509").PasteSpecial Transpose:=True
End If
If aa > 0 Then
.Range("aa6").Copy
Sheets("Output").Range("E510").PasteSpecial Transpose:=True
End If
If ab > 0 Then
.Range("ab6").Copy
Sheets("Output").Range("E511").PasteSpecial Transpose:=True
End If
If ac > 0 Then
.Range("ac6").Copy
Sheets("Output").Range("E512").PasteSpecial Transpose:=True
End If
If ad > 0 Then
.Range("ad6").Copy
Sheets("Output").Range("E513").PasteSpecial Transpose:=True
End If
If ae > 0 Then
.Range("ae6").Copy
Sheets("Output").Range("E503").PasteSpecial Transpose:=True
End If
.Protect "COMPS"
End With

End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

goldfish

Well-known Member
Joined
Aug 23, 2005
Messages
712
Well with the unperdictable pattern of where on output the number gets copied to the code isn't that simple... but I have made it shorter:
Code:
Sub Button85_Click()
Dim ColumnNum As Integer
Sheets("Database").Unprotect "COMPS"
For ColumnNum = 1 To 29
    If Application.WorksheetFunction.CountIf( _
            Sheets("Database").Range("C7:AE7")(ColumnNum).Resize(104, 0).SpecialCells(xlVisible), _
            "X") > 0 Then
        Select Case ColumnNum
        Case 1 To 7
            Sheets("Output").Cells(503 + ColumnNum, 3) = _
                Range("C6:AE6")(ColumnNum).value
        Case 8
            Sheets("Output").Range("C503") = _
                Range("C6:AE6")(ColumnNum).value
        Case 9 To 17
            Sheets("Output").Cells(495 + ColumnNum, 4) = _
                Range("C6:AE6")(ColumnNum).value
        Case 18
            Sheets("Output").Range("D503") = _
                Range("C6:AE6")(ColumnNum).value
        Case 19 To 28
            Sheets("Output").Cells(485 + ColumnNum, 5) = _
                Range("C6:AE6")(ColumnNum).value
        Case 29
            Sheets("Output").Range("E503") = _
                Range("C6:AE6")(ColumnNum).value
        End Select
    End If
Next ColumnNum
Sheets("Database").Protect "COMPS"
End Sub

HTH,
~Gold Fish

Let me know if you have any troubles understand parts of this code. Please do ask question and try to understand this. I know it probably is pretty intimidating for someone who may not have seen For or Select used before, but I promise you that this code is just made up of many easy to understand concepts.
 

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55
Thanks for your help. You are right, I really am struggling to understand what is going on in this code. I'm not familiar with these functions. But I will spend some time reviewing it.


Well with the unperdictable pattern of where on output the number gets copied to the code isn't that simple

I'm not sure what you mean by unpredicable. The data is always copied to the same destination cells in the same order. Can you explain?
 

goldfish

Well-known Member
Joined
Aug 23, 2005
Messages
712
All I meant by that was that the cell to copy is in a nice pattern, C6:AE6, but the place to copy to jumps around... first from C504:C510, then C503, then D504:D512, then D503... so for each different section I had to add another case statement, unlike if you were to be copying to just C504:C533 in which case the code would be much simpler, say
Code:
Sub Button85_Click() 
Dim ColumnNum As Integer 
Sheets("Database").Unprotect "COMPS" 
For ColumnNum = 1 To 29 
    If Application.WorksheetFunction.CountIf( _ 
            Sheets("Database").Range("C7:AE7")(ColumnNum).Resize(104, 0).SpecialCells(xlVisible), _ 
            "X") > 0 Then 
            Sheets("Output").Cells(503 + ColumnNum, 3) = _ 
                Range("C6:AE6")(ColumnNum).value 
    End If 
Next ColumnNum 
Sheets("Database").Protect "COMPS" 
End Sub
But that doesn't accomplish your goals.

Could you further explain what you want the code to be doing and what it is not doing? When you say the code "breaks down", does it error? if so which line does the error occur and what is the error? and if it doesn't error, what percisely is the code doing and what percisely do you want it to be doing?

~Gold Fish
 

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55

ADVERTISEMENT

Could you further explain what you want the code to be doing and what it is not doing? When you say the code "breaks down", does it error? if so which line does the error occur and what is the error? and if it doesn't error, what percisely is the code doing and what percisely do you want it to be doing?

It errors here first because this is the first line that is hidden, it would error on all the ones like it, this one just happens to come first.:

c = Application.WorksheetFunction.CountIf(.Range("C7:C200").SpecialCells(xlVisible), "X")

It errors because I have these cells in collapsed groups and when the macro cannot find the cells then it give me

"Runtime Error 1004 No cells found"

I think this is happening because I am not giving the macro a way out if the cells are grouped or hidden. Thats why i initially thought an IFNOT would. If there is no cell then it should be ignored alltogether. Thats ideally what I would like to happen but I dont know how to apply it to all these lines.
 

goldfish

Well-known Member
Joined
Aug 23, 2005
Messages
712
You have a couple of options. First is easiest, but I do not suggest it as it may change how your code works. "On Error" is a Command that can be used to change how Excel deals with errors.
Code:
On Error Resume Next
At the begining of your code will make excel just skip over any commands in which errors are encountered. This can make code do other things besides intended if you are not careful... just imagin how code would behave if every other line was just not run? Using this solution you can turn errors back on by using
Code:
On Error Goto 0

The method I do suggest is much like what you were seeking, and if statement. For example
Code:
If Range("C7:C200").EntireRow.Hidden Then
Msgbox "Every Row is hidden"
Else
Msgbox "At least one row is visible"
End If
A test like this will tell you if rows 7:200 are all hidden (as this only returns true, if every last one of them is hidden). You won't run into columns being hidden, correct? So either all the columns will break or none of them, so you only have to run one test. So try:

Code:
Sub Button85_Click() 
Dim ColumnNum As Integer 
Sheets("Database").Unprotect "COMPS" 
If Range("C7:C200").EntireRow.Hidden Then
For ColumnNum = 1 To 29 
    If Application.WorksheetFunction.CountIf( _ 
            Sheets("Database").Range("C7:AE7")(ColumnNum).Resize(104, 0).SpecialCells(xlVisible), _ 
            "X") > 0 Then 
        Select Case ColumnNum 
        Case 1 To 7 
            Sheets("Output").Cells(503 + ColumnNum, 3) = _ 
                Range("C6:AE6")(ColumnNum).value 
        Case 8 
            Sheets("Output").Range("C503") = _ 
                Range("C6:AE6")(ColumnNum).value 
        Case 9 To 17 
            Sheets("Output").Cells(495 + ColumnNum, 4) = _ 
                Range("C6:AE6")(ColumnNum).value 
        Case 18 
            Sheets("Output").Range("D503") = _ 
                Range("C6:AE6")(ColumnNum).value 
        Case 19 To 28 
            Sheets("Output").Cells(485 + ColumnNum, 5) = _ 
                Range("C6:AE6")(ColumnNum).value 
        Case 29 
            Sheets("Output").Range("E503") = _ 
                Range("C6:AE6")(ColumnNum).value 
        End Select 
    End If 
Next ColumnNum 
End If
Sheets("Database").Protect "COMPS" 
End Sub
 

jfalcone1

Board Regular
Joined
Jul 13, 2007
Messages
55
EDIT: now that I reread what you wrote. It is not the rows that are being hidden but the columns. They are condensed using grouping.

thanks for all your help.

I think the fact that my existing code is laid out line by line will allow me to use the On Error Resume Next code. If I were to use it, hypothetically, where would I insert it? As a command up top or within each line of code?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,593
Messages
5,637,294
Members
416,963
Latest member
zazama

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