Excel - More efficient way to remove specific borders - performance

How can I make the below code more efficient, at the moment it takes roughly 30 seconds to complete
The code will clear all cells within a selection which have a white background & then clear all diagonal borders within a selection.
With only the clear cells with white background code it finishes instantly but as soon as I added the remove borders code it became slow.
Sub ADULTClearOnly()
Set sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet")
sh2.Select
Cells.Range("B1:F756").Select
For Each Cell In Selection
If Cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then
Cell.Value = ""
End If
Next
Cells.Range("G1:AO757").Select
For Each Cell In Selection
If Cell.Borders(xlDiagonalUp).LineStyle = xlDiagonalUp Then
Cell.Borders(xlDiagonalUp).LineStyle = xlNone
End If
Next
End Sub

There are several issues in your code:
You don't need to, and should not Select to do these actions
Your logic is flawed: xlDiagonalUp is not a LineStyle
Because you are setting any Diagonal Up borders to none, you don't need to iterate the range, do it in one step
So, replace
Cells.Range("G1:AO757").Select
For Each Cell In Selection
If Cell.Borders(xlDiagonalUp).LineStyle = xlDiagonalUp Then
Cell.Borders(xlDiagonalUp).LineStyle = xlNone
End If
Next
with
sh2.Range("G1:AO757").Borders(xlDiagonalUp).LineStyle = xlNone
Similarly,
sh2.Select
Cells.Range("B1:F756").Select
For Each Cell In Selection
If Cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then
Cell.Value = ""
End If
Next
can be reduced to
For Each Cell In sh2.Range("B1:F756")
If Cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then
Cell.ClearContents
End If
Next

Related

Create Buttons and it's signals dynamically in Ruby GTK

i'm trying to make a Nurikabe puzzle with Ruby GTK and i'm having trouble creating button signals dynamically.
Basically, i have a matrix, some boxes have a number ( clicking them won't do anything), others can have one of 3 states (white, black or unplayed). The matrix can have different sizes so i did this :
def construction
# we get the width and height of the matrix
taille_hauteur = ##partie.grilleEnCours.hauteur
taille_largeur = ##partie.grilleEnCours.largeur
#boutons = {}
#We create a table which will include all of our buttons (one for each box of our matrix)
table = Table.new(taille_hauteur,taille_largeur,false)
# we go through our matrix
for i in 0..taille_largeur-1
for j in 0..taille_hauteur-1
# if the box has a number, we create a button with that number as a label
if ##partie.grilleEnCours.matriceCases[i][j].is_a?(CaseNombre)
# we add this button to a hash
#boutons[[i,j]] = Button.new(:label=> ##partie.grilleEnCours.matriceCases[i][j].to_s)
table.attach(#boutons[[i,j]], i, i+1, j, j+1)
else
# otherwise,we create and add a button to the hash without a label
#boutons[[i,j]] = Button.new()
# we create a signal, changing the state of the box of the matrix at the same coordinates as the button
#boutons[[i,j]].signal_connect('clicked'){
puts "#{i} #{j}"
# we change the box's state of the matrix
##partie.clicSurCase(i,j)
puts ##partie.grilleEnCours
# here we are just changing the label corresponding to the box's state
if(##partie.grilleEnCours.matriceCases[i][j].etat==0)
lab = ""
elsif (##partie.grilleEnCours.matriceCases[i][j].etat==1)
lab = "Noir"
else
lab = "Point"
end
#boutons[[i,j]].set_label(lab)
}
table.attach(#boutons[[i,j]], i, i+1, j, j+1)
end
end
end
#object.add(table)
end
The problem is, doing this, when we click any button, it will change the last box of the matrix and the last button's label (bottom right). I believe this is because Integers are objects in Ruby so clicking a button will change the box's state and button's state at the coordinates (i,j) (which are matrix height-1, matrix width-1) and not the values i and j had when we created the signal.
I have no idea how to link a button to a specific box of the matrix (knowing matrixes can have multiple sizes), could you help me on this one ?
It is quite hard to read such a large block of code - maybe start by chopping it into logic-based functions?
It will clear the code up.
you don't need to set "lab =" in each branch of if - just:
lab = if (i==1)
1
else
2
end
in additions - use "case" in this case. Once you split the code up - you will(probably) find the issue you have.
it will be easier to debbug.

Change view of specific split view

I'm looking to have my excel sheet with a split in it (vertically) ensuring a set of controls stay on the left of the screen for easy access. Currently Im using this code to select and move to a cell, based on a list of headings I have in the A column.
Option Explicit
Dim trimProcess() As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
If Not Intersect(ActiveCell, Range("A6:A1000")) Is Nothing Then
If ActiveCell.Value <> "" Then
For i = 0 To UBound(trimProcess)
If ActiveCell.Value = trimProcess(i) Then
Cells(4, 4 * (i + 1)).Select
Cells(4, 4 * (i + 1)).Activate
End If
Next
End If
End If
End Sub
This works fine for what I need, but it only works in the active split view IE if I click a cell in A in the left split, it moves the left split view. I want it so that the changes only the right view, but cant find the code to do so. Is this possible?

Excel - Find All Cells Containing Value and Change Background Color

How do I find all cells containing a text value such as merchant_id and change the background color of those cells to a specific color?
This macro will use the current selected range and check each cell for merchant_id. Then mark it maroon if true. To pick a particular color, the best way is to record a macro and see what values it creates. Take those numbers and replace the contents of the With block
Sub MarkCellsInSelection()
For Each c In Selection
If c.Value = "merchant_id" Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
End If
Next
End Sub

Change cell background color without changing focus

On a form I have 4 MSFlexGrids.
The top grid contains dynamic data, which updates once in a while.
The user can enter data in the cells of the 3 other grids.
The data which is used to fill the top grid is received via a Winsock control, processed, and then the results are written into the appropriate cells using .TextMatrix(intRow, intCol) = strData
This works fine. The data is updated flawlessly, and the user can enter his data into the other 3 grids without any problems.
The problem occurs when I want to change the background color of some cells in the top grid.
On rare occasions the received data is very important, and the background color of the corresponding cells should change color.
I change the color of the cells with the following code:
With grd
For lngRow = 1 To .Rows - 1
'default background color
lngBack = vbWhite
'check for important values
If Val(.TextMatrix(lngRow, 1)) >= lngMax Then
'important color
lngBack = &H3040FF
End If
'select whole row
.Row = lngRow
.Col = 0
.RowSel = lngRow
.ColSel = .Cols - 1
'set the background color of the selected row
.CellBackColor = lngBack
Next lngRow
End With 'grd
The problem with this is that when the user is entering data in the other 3 grids, and the background color of a row in the top grid is changed, then the focus moves to the top grid, and the user has to enter his data anew in the grid where he was working.
Is it possible to change the background color of a cell or whole row in a MSFlexGrid without moving the focus to that grid?
So far I could not find a solution to the problem itself.
I created a work around though :
I created an enum containing a value for each grid:
Public Enum ActiveGrid
enuSystem = 0
enuTel = 1
enuRLN = 2
enuRood = 3
enuData = 4
enuCircuit = 5
End Enum
Whenever a grid gets the focus I save the corresponding enum value in a form level variable.
After coloring the required cells in the first grid I return the focus to the grid which last had it.
The user is not editing in the grid itself, but in a textbox which is laid over the cell, so there is no real problem with the grid losing the focus.
When you look closely though you see the focus leave and return quickly.
For now I will accept this work around, and its minor glitches.
Maybe in the future I can come up with a better solution, or anyone else has a better suggestion?

Partition powerpoint lines into different objects

I have many power point slides and each slide has many lines but all those lines are in the same objects. I want now to add some animation including appears for each line with click.
How I can partition the lines in each slide such that every line will be in its own object
Note, I am using powerpoint 2010
Thanks,
AA
This isn't perfect; you'll need to add more code to pick up ALL of the formatting from the original text, but it's a start. Click within the text box you want to modify, then run the TEST sub. Once it's adjusted to your taste, it's a fairly simple matter to extend it to act on every text box in the entire presentation (though not tables, charts, smartart, stuff like that)
Sub Test()
TextBoxToLines ActiveWindow.Selection.ShapeRange(1)
End Sub
Sub TextBoxToLines(oSh As Shape)
Dim oSl As Slide
Dim oNewShape As Shape
Dim oRng As TextRange
Dim x As Long
With oSh
Set oSl = .Parent
With .TextFrame.TextRange
For x = 1 To .Paragraphs.Count
Set oRng = .Paragraphs(x)
Set oNewShape = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, _
oRng.BoundLeft, oRng.BoundTop, oRng.BoundWidth, oRng.BoundHeight)
With oNewShape
.TextFrame.AutoSize = ppAutoSizeNone
.Left = oRng.BoundLeft
.Top = oRng.BoundTop
.Width = oSh.Width
.Height = oSh.Height
With .TextFrame.TextRange
.Text = oRng.Text
.Font.Name = oRng.Font.Name
.Font.Size = oRng.Font.Size
' etc ... pick up any other font formatting you need
' from oRng, which represents the current paragraph of
' the original text
' Bullets, tabs, etc.
End With
End With
Next
End With
End With
oSh.Delete
End Sub

Resources