Clean Up Code...please

M

menor59

Well-known Member
Joined
Oct 3, 2008
Messages
574
Office Version
  1. 2021
Platform
  1. Windows
I have 2 Sets of Code...

Inserts information but i am having to do a call for each routine as you can see...

Can this be cleaned up into One VBA instead of calling Multiple routines and unprotecting and reprotectiing for each Sub to speed this up a bit...I know its a mess...but im not a VBA guru..I kinda pieced this together...but it does work..

This Loads the information...

VBA Code: 
Sub InsertFormula()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("F3").Formula2 = "=IF(FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet"")=0,"""",FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet""))"
Sheets(i).Protect
Next
Call InsertFormulaReaders
End Sub

Sub InsertFormulaReaders()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("L3:L2000").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
Sheets(i).Protect
Next
Call InsertFormulaRDR
End Sub

Sub InsertFormulaRDR()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("R3:R2000").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
Sheets(i).Protect
Next
Call InsertFormulaDC
End Sub

Sub InsertFormulaDC()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("S3:S2000").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
Sheets(i).Protect
Next
Call InsertFormulaREX
End Sub

Sub InsertFormulaREX()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("T3:T2000").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
Sheets(i).Protect
Next
Call InsertFormulaLK
End Sub

Sub InsertFormulaLK()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("U3:U2000").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
Sheets(i).Protect
Next

    Sheets("Site TOC").Select
    Sheets("Site TOC").Unprotect
    ActiveSheet.Tab.ColorIndex = 2
    Sheets("Site TOC").Protect

End Sub


This code is the same but clears the Load..

VBA Code: 
Sub ClearFormula()

Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("F3").ClearContents
Sheets(i).Protect
Next
Call ClearFormulaReaders
End Sub

Sub ClearFormulaReaders()

Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("L3:L2000").ClearContents
Sheets(i).Protect
Next
Call ClearFormulaRDR
End Sub

Sub ClearFormulaRDR()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("R3:R2000").ClearContents
Sheets(i).Protect
Next
Call ClearFormulaDC
End Sub

Sub ClearFormulaDC()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("S3:S2000").ClearContents
Sheets(i).Protect
Next
Call ClearFormulaREX
End Sub

Sub ClearFormulaREX()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("T3:T2000").ClearContents
Sheets(i).Protect
Next
Call ClearFormulaLK
End Sub

Sub ClearFormulaLK()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Unprotect
Sheets(i).Range("U3:U2000").ClearContents
Sheets(i).Protect
Next

    Sheets("Site TOC").Select
    Sheets("Site TOC").Unprotect
    ActiveSheet.Tab.ColorIndex = 2
    Sheets("Site TOC").Protect

End Sub

Thank you in advance!!!
 
Last edited:
Sort by date Sort by votes
menor59 said:
Shets work Locked and Hidden...
Click to expand...
Try this:

Rich (BB code): 
Sub InsertAllFormulas()
  Dim i As Long
  Application.ScreenUpdating = False
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Visible = -1
      .Select
      .Unprotect
      .Range("F3").Formula2 = "=IF(FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet"")=0,"""",FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet""))"
      .Range("L3:L200").Formula = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
      .Visible = 0
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
  Application.ScreenUpdating = True
End Sub
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Thank you DanteAmor...

Can i ask for one more Clip

I want to do the Same thing above...

But in N3:N200 do

.formula as

Code: 
=IF(L3<>"",IF(SUM(COUNTIF(L3,{"*-IT","*-HR","*-OF","*-MA"})),"This is a CATAGORY Door","This is a GENERAL Door"),"")
and in P3:P200
Code: 
.formula as =IFERROR(IF(G3<>"",IFERROR(VLOOKUP(H3, {"MA","MAINTENANCE ACCESS";"IT","IT ACCESS";"OF","OFFICE ACCESS";"HR","HR ACCESS";"",""},2,0),"GENERAL ACCESS"),""),"")
 
Upvote 0
Try this:

VBA Code: 
      .Range("N3:N200").Formula = "=IF(L3<>"""",IF(SUM(COUNTIF(L3,{""*-IT"",""*-HR"",""*-OF"",""*-MA""})),""This is a CATAGORY Door"",""This is a GENERAL Door""),"""")"
      .Range("P3:P200").Formula = "=IFERROR(IF(G3<>"""",IFERROR(VLOOKUP(H3,{""MA"",""MAINTENANCE ACCESS"";""IT"",""IT ACCESS"";""OF"",""OFFICE ACCESS"";""HR"",""HR ACCESS"";"""",""""},2,0),""GENERAL ACCESS""),""""),"""")"
 
Upvote 0
2022-04-13 21_46_29-Americold_Doors_UPDATE (Completed 04-13-2022) - Copy.xlsm - Excel.jpg


Its not placing it where it should be...It looks like the opposite for

Code: 
 .Range("P3:P200").Formula = "=IFERROR(IF(G3<>"""",IFERROR(VLOOKUP(H3,{""MA"",""MAINTENANCE ACCESS"";""IT"",""IT ACCESS"";""OF"",""OFFICE ACCESS"";""HR"",""HR ACCESS"";"""",""""},2,0),""GENERAL ACCESS""),""""),"""")"
 
Upvote 0
The formula works. I'm not sure what value you should have in H3. In your image you have "-IT", but in the formula you have "IT".

1649912033448.png


If you change the formula to this, it works:

VBA Code: 
      .Range("P3:P200").Formula = "=IFERROR(IF(G3<>"""",IFERROR(VLOOKUP(H3,{""MA"",""MAINTENANCE ACCESS"";""-IT"",""IT ACCESS"";""OF"",""OFFICE ACCESS"";""HR"",""HR ACCESS"";"""",""""},2,0),""GENERAL ACCESS""),""""),"""")"
 
Upvote 0
Ok...I got it working Like this Properly:

Code: 
.Range("P3:P200").Formula = "=IFERROR(VLOOKUP(H3, {""-MA"",""MAINTENANCE ACCESS"";""-IT"",""IT ACCESS"";""-OF"",""OFFICE ACCESS"";""-HR"",""HR ACCESS"";"""",""GENERAL ACCESS""},2,0),"""")"

This is great...

Can you see any more improvement??
VBA Code: 
'--------
'Insert Database to Sheets
'--------

Sub InsertFormulas()
  Dim i As Long
  Application.ScreenUpdating = False
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Select
      .Unprotect
      .Range("F3").Formula2 = "=IF(FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet"")=0,"""",FILTER(Database!$C$2:$H$2000,Database!$B$2:$B$2000=$D$3,""Not In Database Yet""))"
      .Range("L3:L200").Formula = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("N3:N200").Formula = "=IF(L3<>"""",IF(SUM(COUNTIF(L3,{""*-IT"",""*-HR"",""*-OF"",""*-MA""})),""This is a CATAGORY Door"",""This is a GENERAL Door""),"""")"
      .Range("P3:P200").Formula = "=IFERROR(VLOOKUP(H3, {""-MA"",""MAINTENANCE ACCESS"";""-IT"",""IT ACCESS"";""-OF"",""OFFICE ACCESS"";""-HR"",""HR ACCESS"";"""",""GENERAL ACCESS""},2,0),"""")"
      .Range("R3:R200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Select
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
  Application.ScreenUpdating = True
End Sub



'--------
'Clear Sheets from Database
'--------
Sub ClearFormulas()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Unprotect
      .Range("F3, L3:L200, N3:N200, P3:P200, R3:U200").ClearContents
      .Protect
    End With
  Next
    Sheets("Site TOC").Select
    Sheets("Site TOC").Unprotect
    ActiveSheet.Tab.ColorIndex = 2
    Sheets("Site TOC").Protect
End Sub

Thank you SOOOO Much Sir!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Running 2 Macros sequentially when opening a sheet
Replies
5
Views
83
Alex Blakenburg
A
D
  • Question Question
Make the code work in a protected sheet
Replies
7
Views
195
dmt32
D
A
  • Question Question
VBA help - Locking & unlocking on certain times of day
2
Replies
17
Views
469
dmt32
D
M
  • Question Question
Not running code
Replies
0
Views
218
MagicCarpet
M
F
  • Question Question
Update userform
2
Replies
13
Views
286
Formula11
F

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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