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:

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
Try this:

VBA Code: 
Sub InsertAllFormulas()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Unprotect
      .Range("F3").Formula = "=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:L2000").Formula = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R2000").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S2000").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T2000").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U2000").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub

Sub ClearAllFormulas()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Unprotect
      .Range("F3, L3:L2000, R3:U2000").ClearContents
      .Protect
    End With
  Next
End Sub
 
Upvote 0
Thank you SOOOO Much Sir!

THe First line looks like it downed..

But the others didnt


OK...I think the Formula2 needs to be there...

So the First Line of code worked..
Code: 
.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""))"

The lines after that DEBUG

Whatr i modified..

VBA Code: 
Sub InsertAllFormulas()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .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").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub

Sub ClearAllFormulas()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Unprotect
      .Range("F3, L3:L200, R3:U200").ClearContents
      .Protect
    End With
  Next
End Sub

Debug at:

Code: 
 .Range("L3:L200").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"

Probably the same for the other .ranges
 
Last edited:
Upvote 0
menor59 said:
OK...I think the Formula2 needs to be there...
Click to expand...
It must be because of the version, for me Formula2 does not work.

If the macro does not correctly set the formula, you may need to select the sheet, try this:

Rich (BB code): 
Sub InsertAllFormulas()
  Dim i As Long
  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").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub
 
Upvote 0
DanteAmor said:
It must be because of the version, for me Formula2 does not work.

If the macro does not correctly set the formula, you may need to select the sheet, try this:

Rich (BB code): 
Sub InsertAllFormulas()
  Dim i As Long
  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").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub
Click to expand...
That didnt work either...Errors out at the same line...
 
Upvote 0
DanteAmor said:
What does the error say?
Click to expand...
2022-04-13 19_13_13-Window.jpg
2022-04-13 19_14_04-Window.jpg
 
Upvote 0
So...this works...but its too much to do the same thing over and over..

VBA Code: 
'--------
'Unlock Database to Sheets
'--------
Sub InsertFormula()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Unprotect
    End With
  Next
  Call InsertFormulaName
End Sub

'--------
'Insert Database to Sheets
'--------
Sub InsertFormulaName()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
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""))"
Next
Call InsertFormulaReaders
End Sub

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

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

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

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

Sub InsertFormulaLK()
Dim i As Long
For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
Sheets(i).Range("U3:U200").Formula = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
Next
Call CloseFormula
End Sub

'--------
'Lock Sheets to Database
'--------
Sub CloseFormula()
  Dim i As Long
  For i = Sheets("Ignore1").Index + 1 To Sheets("Ignore2").Index - 1
    With Sheets(i)
      .Protect
    End With
  Next
    Sheets("Site TOC").Select
    Sheets("Site TOC").Unprotect
    ActiveSheet.Tab.ColorIndex = 2
    Sheets("Site TOC").Protect
End Sub

I like yours Much better...But it dosent like yours for some reason..

VBA Code: 
Sub InsertAllFormulas()
  Dim i As Long
  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").Formula2 = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
      .Range("R3:R200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - RDR"","""")"
      .Range("S3:S200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - DC"","""")"
      .Range("T3:T200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - REX"","""")"
      .Range("U3:U200").Formula2 = "=IF(G3<>"""",""("" & $D$3 & "") "" & G3 & "" - LK"","""")"
      .Protect
    End With
  Next
  Sheets("Site TOC").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub

I even did (Removed the 2's):

VBA Code: 
Sub InsertAllFormulas()
  Dim i As Long
  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("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").Unprotect
  ActiveSheet.Tab.ColorIndex = 2
  Sheets("Site TOC").Protect
End Sub

But it breaks at the same spot

Right here::

VBA Code: 
.Range("L3:L200").Formula = "=UPPER(IF(G3<>"""",""("" & $D$3 & "") "" & G3 & """" & H3 &"""",""""))"
 
Upvote 0
It works for me. I didn't modify the formulas, I just copied your line and put them in the same cycle. You can try a new book with a sheet with no data.
 
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