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

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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
VBA Keeps Failing due to Range Maybe?
Replies
3
Views
158
menor59
M
K
  • Question
vba code for unlocking cell after paste
Replies
1
Views
58
MikeVol
MikeVol
K
  • Solved
Jump to cell after clicking message box ok
Replies
3
Views
136
dreid1011
dreid1011
F
  • Question
Why Won't This Worksheet_Change Work?!!!
2
Replies
13
Views
198
Fuddy_Duddy
F
E
  • Solved
VBA fails when worksheet is protected?
Replies
1
Views
204
EssKayKay
E

Forum statistics

Threads
1,215,777
Messages
6,126,834
Members
449,343
Latest member
DEWS2031

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