I have a problem with referencing to other cells in my sheet. I have a VBA that creates tables out of a pivot table and saves them on different sheets. Example of the table:
The number of rows for any name can change, the total row position can therefore change too. I needed to bold the whole subtotal and total rows
(in this case it would be B9:G9, B12:G12, B14:G14, A15:G15) so I tried this:
If Right(cell.Value, 5) Like "Total" Then
With cell
.HorizontalAlignment = xlLeft
.Font.Bold = True
End With
End If
Next cell
which naturally only bolded the one cell which has the 'Total' text in it. The problem is referencing to the other cells in the rows I want to bold - the merged cells are messing that up. When I tried this:
cell.EntireRow.Font.Bold = True
the whole Project got bold (A5:G14). I also tried the offset function, but offset(0,1) sent me to cell C5.
Do you please have any idea how to make the whole total and subtotal rows bold?
Thanks,
B.
You could do something like this:
Sub Tester()
Dim ws As Worksheet, c As Range
Set ws = ActiveSheet
For Each c In ActiveSheet.UsedRange.Cells
If c.Value Like "*Total" Then
'from cell with "*Total" to last column
With ws.Range(c, ws.Cells(c.Row, "G"))
.HorizontalAlignment = xlLeft
.Font.Bold = True
End With
End If
Next c
End Sub
Related
I have a filter applied to column CK, I am able to select the next visible row from the header by using the following, which also applies a formula into that active cell.
How do I fill that formula down to the bottom, without affecting the hidden rows?
Occasionally there will be no data, so it's just applying a formula to a blank row..
range("CK1").Select
ActiveSheet.range("$A$1").AutoFilter Field:=89, Criteria1:="0"
' Add if formula to find missing carriers based on patterns
Do
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.EntireRow.Hidden = True
ActiveCell.Formula2R1C1 = _
"=IFS(AND(LEN(RC[1])=18,LEFT(RC[1],2)=""1Z""), ""UPS"", AND(LEN(RC[1])=12,ISNUMBER(RC[1])),""FedEx"",AND(LEN(RC[1])=10,ISNUMBER(RC[1])),""DHL"",AND(LEN(RC[1])=11,LEFT(RC[1],2)=""06""),
It would be great if you could refrain from selecting cells or activating sheets or workbooks like you do. The only time it is fine to have Excel change its selection on screen with VBA is if you want it to.
For your problem, a simple loop will do. Example with CK1 and all the cells below it:
Dim topCell As Range, bottomCell As Range
Set topCell = Range("CK1")
Set bottomCell = topCell.end(xlDown)
'Next test is optional, although recommended (is there no cell filled under CK1?)
If bottomCell.Row >= 1048576 Then 'Current maximal row; you may change the threshold if desired.
Exit Sub
'Alternatively: Exit Function
'Other alternative example: Set bottomCell = Range("CK1000")
End If
Dim c As Range
For Each c In Range(topCell, bottomCell)
If Not c.EntireRow.Hidden Then
c.Formula2R1C1 = "" '<place your formula here>
End If
Next c
I have an Excel file where when I select a salesman from a dropdown list, the worksheet updates to their sales targets and objectives using vlookups to other sheets.
I am trying to use a macro on the objectives section to make the cell size adjust itself to the amount of text in the cell, which can vary depending on which salesman is selected.
I am using merged cells as I want to retain the cell size in rows above the objectives section.
I'm trying to temporarily unmerge the cells to apply a wrap text and autofit to get the cell to fit the text, then put the merge back on.
When I select different Salesman there is some autofitting. The issue is there is a lot of unnecessary space above and below the text.
Sub Adjust_Cells_For_Text()
Range("D33:M42").UnMerge
Range("D33:M42").WrapText = True
Range("D33:M42").EntireRow.AutoFit
Range("D33:M42").EntireColumn.AutoFit
Range("D33:F33").Merge
Range("D34:F34").Merge
Range("D35:F35").Merge
Range("D36:F36").Merge
Range("D37:F37").Merge
Range("D38:F38").Merge
Range("D39:F39").Merge
Range("D40:F40").Merge
Range("D41:F41").Merge
Range("D42:F42").Merge
End Sub
Space around text example
Sub Adjust_Cells_For_Text()
With Range("D33:M42")
.UnMerge
.WrapText = True
.EntireRow.AutoFit
.EntireColumn.AutoFit
End With
Dim rCell As Range
Dim rng As Range: Set rng = Range("D33:D42")
' Merge cells
For Each rCell In rng
rCell.Resize(1, 3).Merge
Next rCell
' Autofit
Rows("33:42").EntireRow.AutoFit
End Sub
I am trying to create add some code to my macro to add a blank row whenever the value in column "B" is blank. I have the following code, but it is not doing what I want it to. It is entering too many blank rows.
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Insert
Sheets("Attendance Audit Hastus").Protect
Any ideas of how I can accomplish this?
If there are four adjacent/consecutive blank cells like B4:B7, the code in the question will insert four rows above them. Try this. It will insert only one row below the blank cells. So the new row will be B8 if the blank cells are B4:B7
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert
Next
End Sub
EDIT
And if you want one row above the blank cells, replace ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert with ar.Cells(1, 1).EntireRow.Insert
For inserting two rows above the blank cells as per comment below
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(1, 1).Resize(2, 1).EntireRow.Insert
Next
End Sub
In order to get all cells in column "B" until the last one, you can do this:
Last_Cell_In_B = Columns("B:B").SpecialCells(xlCellTypeLastCell).Row
Range("B1", "B" & Last_Cell_In_B).Select
Like this, you only add empty rows inside your array, not outside of it.
Your code works perfectly in a standard module, so I think you are trying to use its in a event case, in sheet "Attendance Audit Hastus" right? So you need to double click in your sheet icon in project tree and put this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim MRange As Range
Set MRange = Range("B:B")
If Not Intersect(Target, MRange) Is Nothing Then
For Each cell In Target
MRange.SpecialCells(xlCellTypeBlanks).Select
Next cell
End If
Application.EnableEvents = False
Selection.EntireRow.Insert
Application.EnableEvents = True
End Sub
Note the Application.EnableEvents = False is used here to prevent prevent an infinite loop of cascading events. After the action you need to set Application.EnableEvents = True to return your normal process.
Currently I am using the following code to add a formula to cells in the column for a predefined range of cells. The problem is that the number of cells I need the formula in fluctuates based on how big the data set is.
Range("R9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<0,""False"",""True"")"
Selection.AutoFill Destination:=Range("R9:R12000")
Range("R9:R62053").Select
What I want to do is for every cell that has a value in say column B, I want the macro to insert the formula in the corresponding cell in column C, and stop once it reaches a point where the cell in column b has no value.
The code below is based off the OP's comments. Where as, his code seems to be targeting R9:R12000"
Dim cell As Range, Target As Range
With Worksheets("Sheet1")
Set Target = .Range("B9", .Range("B" & .Rows.Count).End(xlUp))
For Each cell In Target
If cell.Value <> "" Then cell.Offset(0, -1).Formula = "=IF(RC[-1]<0,""False"",""True"")"
Next
End With
Similar to how if you drag a cell down in a spreadsheet it will continue to reference cells in the same row of that formula. I need to find a way that I can search the spreadsheet for letter Y in the I column and if it finds Y in the I column it will then Select the cells in that same row for column B Through AR. then hide just those cells not the entire row. This is what I have so far:
Sub Macro1()
'Sub HideRows()
Dim cell As Range
For Each cell In Range("I1:I5000")
If UCase(cell.Value) = "Y" Then
Select (??? this is where I need to find help selecting the proper range.)
Selection.NumberFormat = ";;;"
End If
Next
Calculate
End Sub
Thanks,
You should be able to use your cell object? No need to Select anything.
For Each cell In Range("I1:I5000")
If UCase(cell.Value) = "Y" Then
cell.NumberFormat = ";;;"
End If
Next
Regarding hiding cells, I don't think you can hide individual cells without hiding the entire row.
cell.EntireRow.Hidden = True
This will set the cell format of column B - H to ;;; on the rows that contain Y in column I.
Sub test()
Dim sht As Worksheet, cell As Range
Dim rangeString As String
Set sht = ActiveSheet
For Each cell In sht.Range("I1:I5000")
If UCase(cell.Value) = "Y" Then
'Columns B --> H
sht.Cells(cell.Row, 2).Resize(1, 7).NumberFormat = ";;;"
End If
Next cell
End Sub
Autofilter would work, but obviously, you're not hiding the cells, since you can only hide full columns or rows. You're just obfuscating the display, but the contents can still be seen in the formula bar.
Sub Macro1()
'Sub HideRows()
Dim cell As Range
with Range("I1:I5000")
.autofilter
.autofilter field:=1,criteria1:="Y"
.offset(1).resize(.rows.count-1).specialcells(xlCellTypeVisible).offset(0,-7).resize(, 43).NumberFormat = ";;;"
.autofilter
end with
End Sub