Help! Need to make "deliverable" macro more efficient

moricarak

New Member
Joined
Aug 5, 2014
Messages
25
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
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

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
Back
Top