dzogchen
10-22-2019, 02:17 AM
Hello everyone!!
In case of budgeting where sometimes the excel quantity list is about 2000 lines it is very nice to have a macro that makes highlight some cells which contains certain words. I developed the following macro that works as intended, but I ask your help if is possible tohighlight the cells that contain the words in the array unless the cell contains the word "circuito" or "valvula"?
Private Sub CommandButton1_Click()
Dim A, B, Comp As Integer
Dim x As Variant
Dim Celula, Celula2 As Integer
x = Array("ultra", "electromagn", "eletromagn", "pressão", "cloro", " pH", "bóia", "nível", "parshall", "redox", "oxigénio")
Application.ScreenUpdating = False
B = (-1)
0:
B = B + 1
If B = 11 Then GoTo 1
On Error Resume Next
For A = 0 To 30
Cells.Find(What:=x(B), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Comp = Len(x(B))
If InStr(ActiveCell, "circuito") Then GoTo 0
'If ActiveCell.Characters(Start:=InStr(ActiveCell, "circuito", Length:=8).Font = True Then GoTo 0
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ActiveCell.Characters(Start:=InStr(ActiveCell, x(B)), Length:=Comp).Font
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'End if
Next A
GoTo 0
1:
Application.ScreenUpdating = True
End Sub
In case of clear the excel file the following macro is not running very well because it freezes the computer for some seconds because the For loop, is there a better way to do the same?
Private Sub CommandButton2_Click()
Dim A As Integer
Application.ScreenUpdating = False
On Error Resume Next
For A = 0 To 50
With Application.FindFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next A
Application.ScreenUpdating = True
End Sub
Thank you!
In case of budgeting where sometimes the excel quantity list is about 2000 lines it is very nice to have a macro that makes highlight some cells which contains certain words. I developed the following macro that works as intended, but I ask your help if is possible tohighlight the cells that contain the words in the array unless the cell contains the word "circuito" or "valvula"?
Private Sub CommandButton1_Click()
Dim A, B, Comp As Integer
Dim x As Variant
Dim Celula, Celula2 As Integer
x = Array("ultra", "electromagn", "eletromagn", "pressão", "cloro", " pH", "bóia", "nível", "parshall", "redox", "oxigénio")
Application.ScreenUpdating = False
B = (-1)
0:
B = B + 1
If B = 11 Then GoTo 1
On Error Resume Next
For A = 0 To 30
Cells.Find(What:=x(B), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Comp = Len(x(B))
If InStr(ActiveCell, "circuito") Then GoTo 0
'If ActiveCell.Characters(Start:=InStr(ActiveCell, "circuito", Length:=8).Font = True Then GoTo 0
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With ActiveCell.Characters(Start:=InStr(ActiveCell, x(B)), Length:=Comp).Font
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'End if
Next A
GoTo 0
1:
Application.ScreenUpdating = True
End Sub
In case of clear the excel file the following macro is not running very well because it freezes the computer for some seconds because the For loop, is there a better way to do the same?
Private Sub CommandButton2_Click()
Dim A As Integer
Application.ScreenUpdating = False
On Error Resume Next
For A = 0 To 50
With Application.FindFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next A
Application.ScreenUpdating = True
End Sub
Thank you!