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("o7200").SpecialCells(xlVisible), "X")
p = Application.WorksheetFunction.CountIf(.Range("p7200").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
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("o7200").SpecialCells(xlVisible), "X")
p = Application.WorksheetFunction.CountIf(.Range("p7200").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