Can this be Fixed....try this on for size

[jfalcone1]

Bear with me here. I have been working on this macro for some time now. The goal is to copy cells "C" through "y" to the cells listed on worksheet "output." The cells that are column headers for an autofilter table and are grouped together based on a higher order.

This macro will work with every column and cell visible, however, if groupings are closed and/or the autofilter is active, the macro does not function. The macro does not break either, the macro will run with no results.


How can this macro worth with any number of autofilters active and some groupings closed.


SOrry for no HTML code, work does not allow.

Sub Button86_Click()


Sheets("Output").Range("C501:c513,d501:d513,e501:e513").ClearContents
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
With Sheets("Database")
On Error Resume Next
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:o200").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")

If c > 0 Then
.Range("c6").Copy
Sheets("Output").Range("C502").PasteSpecial Transpose:=True
ElseIf c = 0 Then
Resume Next
End If
If d > 0 Then
.Range("d6").Copy
Sheets("Output").Range("C503").PasteSpecial Transpose:=True
ElseIf d = 0 Then
Resume Next
End If
If e > 0 Then
.Range("e6").Copy
Sheets("Output").Range("C504").PasteSpecial Transpose:=True
ElseIf e = 0 Then
Resume Next
End If
If f > 0 Then
.Range("f6").Copy
Sheets("Output").Range("C505").PasteSpecial Transpose:=True
ElseIf f = 0 Then
Resume Next
End If
If g > 0 Then
.Range("g6").Copy
Sheets("Output").Range("C506").PasteSpecial Transpose:=True
ElseIf g = 0 Then
Resume Next
End If
If h > 0 Then
.Range("h6").Copy
Sheets("Output").Range("C507").PasteSpecial Transpose:=True
ElseIf h = 0 Then
Resume Next
End If
If i > 0 Then
.Range("i6").Copy
Sheets("Output").Range("C508").PasteSpecial Transpose:=True
ElseIf i = 0 Then
Resume Next
End If
If j > 0 Then
.Range("j6").Copy
Sheets("Output").Range("C501").PasteSpecial Transpose:=True
ElseIf j = 0 Then
Resume Next
End If
If k > 0 Then
.Range("K6").Copy
Sheets("Output").Range("D502").PasteSpecial Transpose:=True
ElseIf k = 0 Then
Resume Next
End If
If l > 0 Then
.Range("l6").Copy
Sheets("Output").Range("D503").PasteSpecial Transpose:=True
ElseIf l = 0 Then
Resume Next
End If
If m > 0 Then
.Range("m6").Copy
Sheets("Output").Range("D504").PasteSpecial Transpose:=True
ElseIf m = 0 Then
Resume Next
End If
If n > 0 Then
.Range("n6").Copy
Sheets("Output").Range("D505").PasteSpecial Transpose:=True
ElseIf n = 0 Then
Resume Next
End If
If o > 0 Then
.Range("o6").Copy
Sheets("Output").Range("D506").PasteSpecial Transpose:=True
ElseIf o = 0 Then
Resume Next
End If
If p > 0 Then
.Range("p6").Copy
Sheets("Output").Range("D507").PasteSpecial Transpose:=True
ElseIf p = 0 Then
Resume Next
End If
If q > 0 Then
.Range("q6").Copy
Sheets("Output").Range("D508").PasteSpecial Transpose:=True
ElseIf q = 0 Then
Resume Next
End If
If r > 0 Then
.Range("r6").Copy
Sheets("Output").Range("D509").PasteSpecial Transpose:=True
ElseIf r = 0 Then
Resume Next
End If
If s > 0 Then
.Range("s6").Copy
Sheets("Output").Range("D510").PasteSpecial Transpose:=True
ElseIf s = 0 Then
Resume Next
End If
If t > 0 Then
.Range("t6").Copy
Sheets("Output").Range("D501").PasteSpecial Transpose:=True
ElseIf t = 0 Then
Resume Next
End If
If u > 0 Then
.Range("U6").Copy
Sheets("Output").Range("E502").PasteSpecial Transpose:=True
ElseIf u = 0 Then
Resume Next
End If
If v > 0 Then
.Range("v6").Copy
Sheets("Output").Range("E503").PasteSpecial Transpose:=True
ElseIf v = 0 Then
Resume Next
End If
If w > 0 Then
.Range("w6").Copy
Sheets("Output").Range("E504").PasteSpecial Transpose:=True
ElseIf w = 0 Then
Resume Next
End If
If x > 0 Then
.Range("x6").Copy
Sheets("Output").Range("E505").PasteSpecial Transpose:=True
ElseIf x = 0 Then
Resume Next
End If
If y > 0 Then
.Range("y6").Copy
Sheets("Output").Range("E501").PasteSpecial Transpose:=True
ElseIf y = 0 Then
Resume Next
End If
End With

End Sub

EDIT: added Code tags - you don't need the HTML maker for that - Moderator

 

[Diffy]

I haven't looked at your question, but your code could be 15x shorter if you just used elements in an array to store all those variables instead of an indvidual Long for each one.

Something like

Dim x(1 to 15) As Long

Use a for loop to fill it with values then another to execute the copying.

 

[jfalcone1]

so you are saying i should use numbers as opposed to letters? forgive me I am not VBA savvy.

 

[Jonmo1]

Haven't tested, but this should do something like what Diffy Said.

Sub Button86_Click() 
Sheets("Output").Range("C501:c513,d501:d513,e501:e513").ClearContents 
With Sheets("Database") 

myarray = Array(502,503,504,505,506,507,508,501,502,503,504,505,506,507,508,509,510,501,502,503,504,505,501) 
myarray2 = Array(3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5)
z=0 

for i = 3 to 25 
    On Error Resume Next 
    x = application.worksheetfunction.countif(.Range(Cells(7,i),Cells(2000,i)).SpecialCells(xlVisible), "X") 

    If x > 0 Then 
        .Cells(6, i).Copy 
        Sheets("Output").Cells(myarray(z),myarray2(z)).PasteSpecial Transpose:=True 
    End If 
    z = z + 1 

next i 

End With 
End Sub()

 

[jfalcone1]

dang guys, thanks a lot, im gonna try to get this going and i'll let you know how it goes.

thanks


J


Ok i have implemented the second piece of code, however, it just copies all of the columns that have a value of X regardless of whether the cells are actually visible or not.

 

[jfalcone1]

I think what is needed at this point is a function that will move the macro to the next column if the value of the previous column is not greater than zero.