Trying to get VBA code to copy over bold formatting? - excel

Here is my current implementation (this is a small section of a much longer script):
Dim j As Integer, q As Integer
q = 2
For j = 1 To 300
If Sheet2.Cells(j, i).Value = "X" Then
Sheet1.Cells(q, 4).Value = Sheet2.Cells(j, 3).Value
If Cells(j, 3).Font.Bold = True Then
Sheet2.Cells(j, 3).Copy
Sheet1.Cells(q, 4).PasteSpecial (xlPasteFormats)
End If
q = q + 1
End If
Next j
This code is looping through a range and finding values that have an X in another column, that's for something else. But I am trying to also get it to copy over specifically the bold formatting. This implementation "works" in that it runs, but confusingly, it only picks up on the bold formatting sometimes, and usually only the first bold entry in a group of bold entries.
I can't have it just copy over every single one, because while that works, it also runs slowly and is generally ugly. Maybe if I included a DoEvents = false it wouldn't be so bad, but still.

Because you're copying and pasting values elsewhere, it's generally a good idea to clear the clipboard after each copy. This may also affect the performance (in a positive way).
Add the following code to immediately after your PasteSpecial line:
Application.CutCopyMode = False
Does the sheet contain any conditional formatting rules that may break?

Related

VBA Insert set number of rows if string found

I am new to macros in Excel, and I’m trying to speed up a process. I need to add a varying number of blank rows, if certain text is present in the cell above it. Not equal, but containing.
For example if A1 contains 'Apples', add two blank rows beneath. If A6 has 'Plums', add four blank rows beneath, etc.
What I have now is this:
For a=1 To ActiveSheet.Cells(Rows.Count,1).End(x1Up).Row
If ActiveSheet.Cells(a,1).Value = “Apples” Then
ActiveSheet.Rows(2).Insert
a = a+1
ELSE
If ActiveSheet.Cells(a,1).Value = “Plums” Then
ActiveSheet.Rows(4).Insert
a = a+1
End If
End Sub
So far I've gotten a Compile Error, stating "Block If without End If" though I believe I closed them both. I'm not sure if I'm correctly comparing or searching for a string as well (referring to my use of ="Apples"), but cannot get it to run at all to test that part.
For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TypeName(ActiveSheet.Cells(a, 1)) = "String" Then
If ActiveSheet.Cells(a, 1).Value = "Apples" Then
ActiveSheet.Rows(2).Insert
a = a + 1
ElseIf ActiveSheet.Cells(a, 1).Value = "Plums" Then 'One error here
ActiveSheet.Rows(4).Insert
a = a + 1
End If
End If
Next 'And here too

VBA - Base Rowheigth on Font size

I've been working with Excel-VBA for a few weeks now, and have learned a lot, especially from StackOverflow. I just have one problem that's beyond me.
I've made an Excel workbook for a price list in 6 versions. It has to be designed so that only one version has to be corrected in case of changes or errors; the other versions will be changed with the press of a button. Everything works, except for one thing: I want row heights to change based on the font size of one cell in that row.
Specifically, the third column sometimes contains headers with a font size of 20. In that case, the row height needs to be 26.25. In all other cases, the row height must be 12.75. Currently I'm using the following code. It seems to work, but it's painfully slow:
For j = 1 To lastrow
If Cells(j, 3).Font.Size = 20 Then
Rows.Cells(j, 3).RowHeight = 26.25
Else
Rows.Cells(j, 3).RowHeight = 12.75
End If
Next j
I've tried some other things, including the following code (with cell and nicrange declared as Range), but that doesn't work:
For Each cell In nicrange
If cell.Font.Size = 20 Then
cell.RowHeight = 26.25
Else
cell.RowHeight = 12.75
End If
Next
It's probably just a simple mistake, but I can't figure it out. Any help would be much appreciated. Thank you!
Sander
Use this approach to get the lastRow. Then, simplify your condition:
For j = 1 To lastrow
With Cells(j,3)
.RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
End With
Next
If lastRow is a very large number, then this requires many iterations, and can usually be optimized by disabling ScreenUpdating and Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For j = 1 To lastrow
With Cells(j,3)
.RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Changing cell value for a range of cells without multiple if statments

I would like to change the color of a cell based on the value of an adjacent cell. The following code is working properly for a single cell, but I would like it to apply to a range of cells, currently it looks at the value of S5 and changes to color of T5, I would like this to iterate for a range of cells (S5 to S100 matching with T5 to T100). How can I do this without needing to make an if statement for 100 cells?
If LCase(Sheets(1).Range("S5").Value) = "yes" Then
Sheets(1).Range("T5").Interior.ColorIndex = 33
ElseIf Sheets(1).Range("S5").Value <> "" Then
Sheets(1).Range("T5").Interior.ColorIndex = 19
Else
Sheets(1).Range("T5").Interior.ColorIndex = 0
End If
To elaborate on my comment, you could do something like this:
For i = 5 to 100
If LCase(Sheets(1).Range("S"&i).Value) = "yes" Then
Sheets(1).Range("T"&i).Interior.ColorIndex = 33
ElseIf Sheets(1).Range("S"&i).Value <> "" Then
Sheets(1).Range("T"&i).Interior.ColorIndex = 19
Else
Sheets(1).Range("T"&i).Interior.ColorIndex = 0
End If
Next i
Note how instead of referring directly to "S5", instead the code refers to Si [for whatever number i is, starting at 5 and going row by row up to 100].
Conditional formatting in EXCEL would probably be the best way to handle this:
Conditional Formatting
Grade 'Eh' Bacon gave a good solution for doing this, and it is acceptable. Here is another solution that should work fine and allows some different math based Column/Row solutions if you need to make these actions more modular.
Set myRange = Range("S5:S100")
For Each cell in myRange
If LCase(cell.Value) = "yes" Then
cell.Offset(0, 1).Interior.ColorIndex = 33
ElseIf LCase(cell.Value) = "no" Then
cell.Offset(0, 1).Interior.ColorIndex = 19
Else
cell.Offset(0, 1).Interior.ColorIndex = 0
End If
Next
Range Offset Information
Here is an interesting way to do this:
Const FORMULA = "CHOOSE(MMULT(--(~>{""yerz"",""""}),{1;1})+1,0,19,33)"
With [t5:t100]
v = Evaluate(Replace(FORMULA, "~", .Address))
For i = 1 To .Count
.Item(i, 2).Interior.ColorIndex = v(i, 1)
Next
End With
This small solution packs a lot of learning opportunities that can be leveraged far beyond this question.
Notice that your color numbers can be edited at the end of the first line.
Here is what is happening.
We use the Evaluate function to evaluate a formula that takes your range of values T5:T100 and produces an array of color numbers.
We then assign each value in the array to the ColorIndex of the cell to the right.
The challenging part is creating the formula that will result in the appropriate array of color numbers. :)

Excel - Split apart a list

I have a list of about 300 items, that I need spaced out every 8 cells as opposed to being one after the other. I'm sure there is an easy way to do this, however my brain is failing me. I have a feeling my terminology is hurting hence why I can't find an answer.
=IF(MOD(ROW()+7;8)=0;INDEX(A:A;INT(ROW()/8)+1);"")
Given that data begins at A1 and formula is used from row 1 (coulmn is not important).
Try below code
Sub Main()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastRow
If i = 1 Then
Cells(i, 5).Value = Cells(i, 1)
Else
Cells((i - 1) * 9, 5).Value = Cells(i, 1)
End If
Next
End Sub
Output
Can you please post a screen shot or add some additional detail?
Two things come to my mind for possible solutions:
1) Use Text to columns (if that is where you're going with this) or
2) Use a formula like =LEFT(A1, 10) in the 8th column and fill down (10 can be changed to whatever the first part of the string is that needs to be separated).
Provide some additional info and I'll take another look!

How to use AND in IF Statement

I want to check:
IF cells (i,"A") contains the text 'Miami' AND (i,"D") contains the text 'Florida' THEN change value of cell (i,"C") to BA.
Sub ABC()
Dim wsh As Worksheet, i As Long, lngEndRowInv As Long
Set wsh = ActiveSheet
i = 2
lngEndRowInv = wsh.Range("A" & wsh.Rows.Count).End(xlUp).Row
While i <= lngEndRowInv
If Cells(i, "A") like "*Miami*" And Cells(i, "D") like "*Florida*" Then
Cells(i, "C").Value = "BA"
End If
i = i + 1
Wend
End Sub
Brief syntax lesson
Cells(Row, Column) identifies a cell. Row must be an integer between 1 and the maximum for version of Excel you are using. Column must be a identifier (for example: "A", "IV", "XFD") or a number (for example: 1, 256, 16384)
.Cells(Row, Column) identifies a cell within a sheet identified in a earlier With statement:
With ActiveSheet
:
.Cells(Row,Column)
:
End With
If you omit the dot, Cells(Row,Column) is within the active worksheet. So wsh = ActiveWorkbook wsh.Range is not strictly necessary. However, I always use a With statement so I do not wonder which sheet I meant when I return to my code in six months time. So, I would write:
With ActiveSheet
:
.Range.
:
End With
Actually, I would not write the above unless I really did want the code to work on the active sheet. What if the user has the wrong sheet active when they started the macro. I would write:
With Sheets("xxxx")
:
.Range.
:
End With
because my code only works on sheet xxxx.
Cells(Row,Column) identifies a cell. Cells(Row,Column).xxxx identifies a property of the cell. Value is a property. Value is the default property so you can usually omit it and the compiler will know what you mean. But in certain situations the compiler can be confused so the advice to include the .Value is good.
Cells(Row,Column) like "*Miami*" will give True if the cell is "Miami", "South Miami", "Miami, North" or anything similar.
Cells(Row,Column).Value = "Miami" will give True if the cell is exactly equal to "Miami". "MIAMI" for example will give False. If you want to accept MIAMI, use the lower case function:
Lcase(Cells(Row,Column).Value) = "miami"
My suggestions
Your sample code keeps changing as you try different suggestions which I find confusing. You were using Cells(Row,Column) <> "Miami" when I started typing this.
Use
If Cells(i, "A").Value like "*Miami*" And Cells(i, "D").Value like "*Florida*" Then
Cells(i, "C").Value = "BA"
if you want to accept, for example, "South Miami" and "Miami, North".
Use
If Cells(i, "A").Value = "Miami" And Cells(i, "D").Value like "Florida" Then
Cells(i, "C").Value = "BA"
if you want to accept, exactly, "Miami" and "Florida".
Use
If Lcase(Cells(i, "A").Value) = "miami" And _
Lcase(Cells(i, "D").Value) = "florida" Then
Cells(i, "C").Value = "BA"
if you don't care about case.
If there are no typos in the question, you got the conditions wrong:
You said this:
IF cells (i,"A") contains the text 'Miami'
...but your code says:
If Cells(i, "A") <> "Miami"
--> <> means that the value of the cell is not equal to "Miami", so you're not checking what you think you are checking.
I guess you want this instead:
If Cells(i, "A") like "*Miami*"
EDIT:
Sorry, but I can't really help you more. As I already said in a comment, I'm no Excel VBA expert.
Normally I would open Excel now and try your code myself, but I don't even have Excel on any of my machines at home (I use OpenOffice).
Just one general thing: can you identify the row that does not work?
Maybe this helps someone else to answer the question.
Does it ever execute (or at least try to execute) the Cells(i, "C").Value = "BA" line?
Or is the If Cells(i, "A") like "*Miami*" stuff already False?
If yes, try checking just one cell and see if that works.
If you are simply looking for the occurrence of "Miami" or "Florida" inside a string (since you put * at both ends), it's probably better to use the InStr function instead of Like. Not only are the results more predictable, but I believe you'll get better performance.
Also, VBA is not short-circuited so when you use the AND keyword, it will test both sides of the AND, regardless if the first test failed or not. In VBA, it is more optimal to use 2 if-statements in these cases, that way you aren't checking for "Florida" if you don't find "Miami".
The other advice I have is that a for-each loop is faster than a for-loop. Using .offset, you can achieve the same thing, but with better effeciency. Of course there are even better ways (like variant arrays), but those will add a layer of complexity not needed in this example.
Here is some sample code:
Sub test()
Application.ScreenUpdating = False
Dim lastRow As Long
Dim cell As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range("A1:A" & lastRow)
If InStr(1, cell.Value, "Miami") <> 0 Then
If InStr(1, cell.Offset(, 3).Value, "Florida") <> 0 Then
cell.Offset(, 2).Value = "BA"
End If
End If
Next
Application.ScreenUpdating = True
End Sub
I hope you find some of this helpful, and keep at it with VBA! ^^
I think you should append .value in IF statement:
If Cells(i, "A").Value <> "Miami" And Cells(i, "D").Value <> "Florida" Then
Cells(i, "C").Value = "BA"
End IF

Resources