Hello,
I am trying to fix a macro that hides the listed "deliverables" on my WS. With lower number of deliverables, the macro executes quite quickly, but once there are 10 or more deliverables the macro takes a very very long time. Is there a way to simply or fix the following macro to make it more efficient?
Thank you so much!
_______________________________________________________________
Dim I As Integer
Dim J As Integer
Dim L As Integer
Dim M As Integer
Dim K As Variant 'If Dim as a Integer or Long, the Investments portion won't work (I don't know why)
Dim MaterialToHide As Object
Dim LaborToHide As Object
Dim PurchasePartsToHide As Object
Dim Operations As Object
Dim InvestmentsToHide As Object
Dim MaterialToHideTool As Object
Dim PurchasePartsToHideTool As Object
Dim AssembliesToHideTool As Object
Sub HideDeliverables()
'In the Worksheet Tab
'Hides Deliverables
I = 29
M = 0
For J = 0 To Range("a2").Value
'If the white top says "Hide Deliverable", then it hides it
If Cells(2, I) = "HIDE DELIVERABLE" Then
Range("ab:af").Offset(0, J * 5).EntireColumn.Hidden = True
End If
I = I + 5
Next J
'Hides stampings
If Range("b2") > 0 Then
L = 14
I = 29
M = 0
Do
'Set the dimensions
Set MaterialToHide = Range("14:14").Offset(M, 0)
Set LaborToHide = Range("24:24").Offset(M + Range("B2"), 0)
For J = 0 To Range("a2").Value
'If White Top doesn't say "Hide Deliverable" then it defines K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Checks the next column over
I = I + 5
Next J
'If K is equal to 0, then it hides the row
If K = 0 Then
MaterialToHide.EntireRow.Hidden = True
LaborToHide.EntireRow.Hidden = True
End If
'Moves down and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("b2")
End If
'Hides Purchase parts
If Range("c2") > 0 Then
'Sets L down to Purchase Parts
L = 34 + (Range("B2") * 2)
I = 29
M = 0
Do
Set PurchasePartsToHide = Range("34:34").Offset((Range("B2") * 2) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
PurchasePartsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("c2")
End If
'Hides Operations
If Range("d2") > 0 Then
'Sets L down to Operations
L = 44 + (Range("B2") * 2) + Range("C2")
I = 29
M = 0
Do
Set OperationsToHide = Range("44:44").Offset((Range("B2") * 2) + Range("C2") + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
OperationsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("d2")
End If
'Hides Investments
If Range("e2") + Range("f2") Then
'Sets L down to Investments
L = 55 + (Range("B2") * 2) + Range("C2") + Range("D2")
I = 29
M = 0
Do
Set InvestmentsToHide = Range("55:55").Offset((Range("B2") * 2) + Range("C2") + Range("D2") + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I + 1).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
InvestmentsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 2
M = M + 2
K = 0
I = 29
Loop Until M = (Range("e2") + Range("f2")) * 2
End If
'Tooling Tab
ActiveWorkbook.Sheets("Tooling").Activate
'Hides Deliverables
For J = 0 To Range("a2").Value
'If the white tab at the top says "Hide Deliverable" then it hides then
If Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
Range("ab:af").Offset(0, J * 5).EntireColumn.Hidden = True
End If
'Moves over a deliverable
I = I + 5
Next J
'Hides stampings
If Range("b2") > 0 Then
I = 29
L = 16
M = 0
Do
Set MaterialToHideTool = Range("16:16").Offset(M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
MaterialToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = (Range("b2") * 2) + (Range("B3") * 3)
End If
'Hides Purchase parts
If Range("c2") > 0 Then
I = 29
L = 26 + (Range("B2") * 2) + (Range("B3") * 3)
M = 0
Do
Set PurchasePartsToHideTool = Range("26:26").Offset((Range("B2") * 2) + (Range("B3") * 3) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
PurchasePartsToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("c2")
End If
'Hides Operations
If Range("d2") > 0 Then
I = 29
L = 37 + (Range("B2") * 2) + (Range("C2")) + (Range("b3") * 3)
M = 0
Do
Set AssembliesToHideTool = Range("37:37").Offset((Range("B2") * 2) + (Range("B3") * 3) + (Range("C2")) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
AssembliesToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("d2") * 2
End If
'(P&L)
ActiveWorkbook.Sheets("P&L").Activate
'Hides Deliverables
I = 29
For J = 0 To Range("a2").Value
If Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
Range("R:V").Offset(0, J * 5).EntireColumn.Hidden = True
End If
I = I + 5
Next J
ActiveWorkbook.Sheets("WS").Activate
End Sub
I am trying to fix a macro that hides the listed "deliverables" on my WS. With lower number of deliverables, the macro executes quite quickly, but once there are 10 or more deliverables the macro takes a very very long time. Is there a way to simply or fix the following macro to make it more efficient?
Thank you so much!
_______________________________________________________________
Dim I As Integer
Dim J As Integer
Dim L As Integer
Dim M As Integer
Dim K As Variant 'If Dim as a Integer or Long, the Investments portion won't work (I don't know why)
Dim MaterialToHide As Object
Dim LaborToHide As Object
Dim PurchasePartsToHide As Object
Dim Operations As Object
Dim InvestmentsToHide As Object
Dim MaterialToHideTool As Object
Dim PurchasePartsToHideTool As Object
Dim AssembliesToHideTool As Object
Sub HideDeliverables()
'In the Worksheet Tab
'Hides Deliverables
I = 29
M = 0
For J = 0 To Range("a2").Value
'If the white top says "Hide Deliverable", then it hides it
If Cells(2, I) = "HIDE DELIVERABLE" Then
Range("ab:af").Offset(0, J * 5).EntireColumn.Hidden = True
End If
I = I + 5
Next J
'Hides stampings
If Range("b2") > 0 Then
L = 14
I = 29
M = 0
Do
'Set the dimensions
Set MaterialToHide = Range("14:14").Offset(M, 0)
Set LaborToHide = Range("24:24").Offset(M + Range("B2"), 0)
For J = 0 To Range("a2").Value
'If White Top doesn't say "Hide Deliverable" then it defines K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Checks the next column over
I = I + 5
Next J
'If K is equal to 0, then it hides the row
If K = 0 Then
MaterialToHide.EntireRow.Hidden = True
LaborToHide.EntireRow.Hidden = True
End If
'Moves down and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("b2")
End If
'Hides Purchase parts
If Range("c2") > 0 Then
'Sets L down to Purchase Parts
L = 34 + (Range("B2") * 2)
I = 29
M = 0
Do
Set PurchasePartsToHide = Range("34:34").Offset((Range("B2") * 2) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
PurchasePartsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("c2")
End If
'Hides Operations
If Range("d2") > 0 Then
'Sets L down to Operations
L = 44 + (Range("B2") * 2) + Range("C2")
I = 29
M = 0
Do
Set OperationsToHide = Range("44:44").Offset((Range("B2") * 2) + Range("C2") + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
OperationsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("d2")
End If
'Hides Investments
If Range("e2") + Range("f2") Then
'Sets L down to Investments
L = 55 + (Range("B2") * 2) + Range("C2") + Range("D2")
I = 29
M = 0
Do
Set InvestmentsToHide = Range("55:55").Offset((Range("B2") * 2) + Range("C2") + Range("D2") + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I + 1).Value + K
End If
'Looks at the next deliverable over
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
InvestmentsToHide.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 2
M = M + 2
K = 0
I = 29
Loop Until M = (Range("e2") + Range("f2")) * 2
End If
'Tooling Tab
ActiveWorkbook.Sheets("Tooling").Activate
'Hides Deliverables
For J = 0 To Range("a2").Value
'If the white tab at the top says "Hide Deliverable" then it hides then
If Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
Range("ab:af").Offset(0, J * 5).EntireColumn.Hidden = True
End If
'Moves over a deliverable
I = I + 5
Next J
'Hides stampings
If Range("b2") > 0 Then
I = 29
L = 16
M = 0
Do
Set MaterialToHideTool = Range("16:16").Offset(M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
MaterialToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = (Range("b2") * 2) + (Range("B3") * 3)
End If
'Hides Purchase parts
If Range("c2") > 0 Then
I = 29
L = 26 + (Range("B2") * 2) + (Range("B3") * 3)
M = 0
Do
Set PurchasePartsToHideTool = Range("26:26").Offset((Range("B2") * 2) + (Range("B3") * 3) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
PurchasePartsToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("c2")
End If
'Hides Operations
If Range("d2") > 0 Then
I = 29
L = 37 + (Range("B2") * 2) + (Range("C2")) + (Range("b3") * 3)
M = 0
Do
Set AssembliesToHideTool = Range("37:37").Offset((Range("B2") * 2) + (Range("B3") * 3) + (Range("C2")) + M, 0)
For J = 0 To Range("a2").Value
'If the white top doesn't say "Hide Deliverable", then it sets K
If Not Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
K = Cells(L, I).Value + K
End If
'Moves over a deliverables
I = I + 5
Next J
'If K is equal to 0, then it hides it
If K = 0 Then
AssembliesToHideTool.EntireRow.Hidden = True
End If
'Goes down a row and repeats
L = L + 1
M = M + 1
K = 0
I = 29
Loop Until M = Range("d2") * 2
End If
'(P&L)
ActiveWorkbook.Sheets("P&L").Activate
'Hides Deliverables
I = 29
For J = 0 To Range("a2").Value
If Sheets("WS").Cells(2, I) = "HIDE DELIVERABLE" Then
Range("R:V").Offset(0, J * 5).EntireColumn.Hidden = True
End If
I = I + 5
Next J
ActiveWorkbook.Sheets("WS").Activate
End Sub