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

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
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

M
  • Question Question
Not running code
Replies
0
Views
207
MagicCarpet
M
M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
516
MagicCarpet
M
H
  • Solved
Copy/Move Data from a table to another Sheet to a table
Replies
2
Views
331
himaruasuka
H
M
  • Question Question
VBA Keeps Failing due to Range Maybe?
Replies
3
Views
234
menor59
M
K
  • Question Question
vba code for unlocking cell after paste
Replies
1
Views
273
MikeVol
MikeVol

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

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