I am working as a validation technician for excel spreadsheets in a pharma company. Sadly & interestingly I don't know much about VBA and Excel.
To validate those excel spreadsheet, I developped with macro-recording the following code, which helps me identifying the cell properties.
The goal is to quickly obtain relevant parameters by entering minimum of informations (password; analysis range)
Here is an example of what I am currently achieving :
Running the macro
Question :
how can I improve this code so it runs faster
If anybody worked with this kind of macro : any suggestions for further developments are welcome
Here are some ideas I cannot implement yet due to lack of knowledge
Ideas for further improvement :
Currently code overwrites worksheet name because I dont know how to extract sheet name
Ideally, it would be better to copy the worksheet then add the custom formula on the second sheet, so the original worksheet isn't changed
Insert input box to define worksheet and workbook password (these two have the same password)
Wish I could retrieve even more informations but I dont know how (such as existing data-validation requirements etc etc)
Sorry for your eyes, dear developpers, I am aware its really messy code but I didnt find a way to clear it efficiently, and it's currently working fine but rather slowly with old computer
Many thanks for your help,
Max
Option Explicit
Public Const MDP As String = "PASSWORD"
----------
Sub Cell_analysis()
'Unprotect
ActiveSheet.Unprotect Password:=MDP
ActiveWorkbook.Unprotect Password:=MDP
'Define range with input box
Dim rng As Range
Dim DefaultRange As Range
Dim FormatRuleInput As String
ActiveSheet.Name = "Sheet1"
If TypeName(Selection) = "Range" Then
Set DefaultRange = Selection
Else
Set DefaultRange = ActiveCell
End If
On Error Resume Next
Set rng = Application.InputBox( _
Title:="Select Worksheet Range", _
Prompt:="Select Worksheet Range", _
Default:=DefaultRange.Address, _
Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
'Unmerge all cells
rng.UnMerge
'Use following formula to retrieve cell informations
ActiveSheet.Copy After:=Sheets(1)
rng.Cells.FormulaR1C1 = "=CELL(""Format"",'Sheet1 (2)'!RC)&"" , ""&CELL(""Protect"",'Sheet1 (2)'!RC)&"" , ""&ISFORMULA('Sheet1 (2)'!RC)"
'Conditional formatting
Dim condition1, condition2, condition3, condition4, condition5, condition6, condition7, condition8, condition9, condition10, condition11, condition12, condition13, condition14, condition15, condition16, condition17, condition18, condition19, condition20, condition21, condition22, condition23, condition24, condition25, condition26 As FormatCondition
'Clear existing formatting
rng.FormatConditions.Delete
'List conditions
Set condition1 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="G , 0")
Set condition2 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D1 , 0")
Set condition3 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D2 , 0")
Set condition4 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F0 , 0")
Set condition5 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F1 , 0")
Set condition6 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F2 , 0")
Set condition7 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F3 , 0")
Set condition8 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F4 , 0")
Set condition9 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F5 , 0")
Set condition10 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F6 , 0")
Set condition11 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F7 , 0")
Set condition12 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F8 , 0")
Set condition13 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F9 , 0")
Set condition14 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="G , 1")
Set condition15 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D1 , 1")
Set condition16 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D2 , 1")
Set condition17 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F0 , 1")
Set condition18 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F1 , 1")
Set condition19 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F2 , 1")
Set condition20 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F3 , 1")
Set condition21 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F4 , 1")
Set condition22 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F5 , 1")
Set condition23 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F6 , 1")
Set condition24 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F7 , 1")
Set condition25 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F8 , 1")
Set condition26 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F9 , 1")
'conditional formatting options
With condition1
.Interior.Color = RGB(255, 255, 255)
.Font.ColorIndex = 3
End With
With condition2
.Interior.Color = RGB(153, 204, 255)
.Font.ColorIndex = 3
End With
With condition3
.Interior.Color = RGB(102, 178, 255)
.Font.ColorIndex = 3
End With
With condition4
.Interior.Color = RGB(229, 255, 204)
.Font.ColorIndex = 3
End With
With condition5
.Interior.Color = RGB(204, 255, 153)
.Font.ColorIndex = 3
End With
With condition6
.Interior.Color = RGB(178, 255, 102)
.Font.ColorIndex = 3
End With
With condition7
.Interior.Color = RGB(153, 255, 51)
.Font.ColorIndex = 3
End With
With condition8
.Interior.Color = RGB(128, 218, 0)
.Font.ColorIndex = 3
End With
With condition9
.Interior.Color = RGB(102, 204, 0)
.Font.ColorIndex = 3
End With
With condition10
.Interior.Color = RGB(76, 153, 0)
.Font.ColorIndex = 3
End With
With condition11
.Interior.Color = RGB(51, 102, 0)
.Font.ColorIndex = 3
End With
With condition12
.Interior.Color = RGB(37, 72, 0)
.Font.ColorIndex = 3
End With
With condition13
.Interior.Color = RGB(25, 45, 0)
.Font.ColorIndex = 3
End With
With condition14.Interior
.Color = RGB(255, 255, 255)
End With
With condition15.Interior
.Color = RGB(153, 204, 255)
End With
With condition16.Interior
.Color = RGB(102, 178, 255)
End With
With condition17.Interior
.Color = RGB(229, 255, 204)
End With
With condition18.Interior
.Color = RGB(204, 255, 153)
End With
With condition19.Interior
.Color = RGB(178, 255, 102)
End With
With condition20.Interior
.Color = RGB(153, 255, 51)
End With
With condition21.Interior
.Color = RGB(128, 218, 0)
End With
With condition22.Interior
.Color = RGB(102, 204, 0)
End With
With condition23.Interior
.Color = RGB(76, 153, 0)
End With
With condition24.Interior
.Color = RGB(51, 102, 0)
End With
With condition25.Interior
.Color = RGB(37, 72, 0)
End With
With condition26.Interior
.Color = RGB(25, 45, 0)
End With
'Select the sheet to see the final result
Worksheets("Sheet1").Activate
'Result shaping
rng.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.ColumnWidth = 15
.RowHeight = 18
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Name = "Calibri"
.Font.Bold = True
.Font.Size = 11
.Font.Underline = False
.Font.Italic = False
End With
'Display result of analyzed cells
MsgBox rng.Count & " Cells treated : " & rng.Columns.Count & " Columns" & " & " & rng.Rows.Count & " Rows"
End Sub
Object-Browser
inVBA-IDE
(on view tab) to get all members of a type (e.g Range). \$\endgroup\$