I have an issue with filling blank cells of a column.
I have 3 Column headings in A, B, C.
Under that I have variable amounts of rows, but column A and B will always have data.
Column C could have gaps. How could I do something similar to:
Edit > Go To > Special > Blanks, type = in the formula bars, hit the up arrow then Ctrl+Enter
EXCEPT, with the macro only going up until the last row of A and no further.
I have:
Sub FillCellsFromAbove()
' Turn off screen updating to improve performance
Application.ScreenUpdating = False
On Error Resume Next
' Look in column A
With Columns(3)
' For blank cells, set them to equal the cell above
.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End With
Err.Clear
Application.ScreenUpdating = True
End Sub
It however fills right from the bottom of the page and not from where the last "A" value is.
Don't use all of Column C -- first determine how far the data in Column A extends and then grab that many cells in column C:
Sub FillCellsFromAbove()
Dim R As Range, n As Long
n = Range("A:A").Rows.Count
n = Cells(n, "A").End(xlUp).Row
Set R = Range(Cells(1, 3), Cells(n, 3))
Application.ScreenUpdating = False
On Error Resume Next
With R
' For blank cells, set them to equal the cell above
.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End With
Err.Clear
Application.ScreenUpdating = True
End Sub
You might want to test for blanks before attempting to put formulas into cells that may not exist.
With Columns(3).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1)
If CBool(Application.CountBlank(.Cells)) Then
' For blank cells, set them to equal the cell above
.Cells.SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
'Convert the formula to a value
.Value = .Value
End If
End With
Related
I wrote VBA code to hide the rows in my chart where in the cell of column G the value "XYZ" occurs.
i = 4 ' row to begin with
j = Cells(i, 7).End(xlDown).Row
clmn = 7 ' column G
mark = False
For row = j To i Step -1
If (Cells(row, clmn).Value = "XYZ") Then
If mark Then
Union(Selection, Rows(row)).Select
Else
Rows(row).Select
mark = True
End If
End If
Next row
Selection.EntireRow.Hidden = True
This works totally fine. Now after working in this modifies chart I'd like to add a second attaching VBA code so that all the hidden rows with "XYZ" in column G reappear BUT only if in column A of the same row there stands "ABC". So not all of the hidden rows should unhide.
How do I have to modify my own code to have this done?
you could use AutoFilter and go like follows:
Sub UnhideThem()
Dim visbileRng As Range
With Range("G3", Cells(Rows.Count, "A").End(xlUp)) ' reference columns A:G from row 3 (headers) down to column A last not empty row
Set visbileRng = .SpecialCells(xlCellTypeVisible) ' store currently visible range
.AutoFilter field:=1, Criteria1:="ABC" ' filter referenced range on its first column (i.e. "A") with value "ABC"
.AutoFilter field:=7, Criteria1:="XYZ" ' filter referenced range on its 7th column (i.e. "A") with value "ABC"
With .Resize(.Rows.Count - 1).Offset(1) ' reference "data" rows only (i.e skip "header" row)
If CBool(Application.Subtotal(103, .Cells)) Then Set visbileRng = Union(visbileRng, .SpecialCells(xlCellTypeVisible)) 'if any filtered row in referenced range then add it to 'visbleRng'
End With
.Parent.AutoFilterMode = False ' remove filters
.EntireRow.Hidden = True 'hide all referenced range rows
visbileRng.EntireRow.Hidden = False ' unhide only rows to set visible
End With
End Sub
As Redji comment, just add a condition to your If clause. anyway, I don't prefer using the union and select approach.
If Cells(row, clmn).Value = "XYZ" and _
Cells(row, 1).Value = "ABC" Then
' do the selection if you like
Selection.EntireRow.Hidden = false
you also can use the specialcells as well. for instance, if your range is A4:G & j you can address this code in your chart.
range("a4:g" & j).Rows.SpecialCells(xlCellTypeVisible)
Regards,
M
I'm new to VBA and English isn't my native language so here goes.
I want to conditional format rows/ range (giving them green-colored background) if cell C in that row have duplicate value in column C and also if there's a cell in column O that equals 0, but if the cell in column C has no similar value, don't apply the conditional format to that cell (eventhough cells in column O has the value of 0).
Note: Cells that have same values in column C will always be above and below each other, for example it's possible that C1=C2=C3 but not C1<>C2, C1=C3
I know I'm not explaining it clearly, so please just let me know if you want more information.
Update (more information): I may have 3 or more rows with same C column value above and below each other, and the zero value in column O will always be the bottom row.
Example:
If C1=C2=C3=C4=C5 and O5=0 , Rows 1 2 3 4 5 become green colored.
I prefer using conditional format even if it needs vba code so I dont have to run it everytime there's new 0 in column O.
I've used this code but it doesn't work (obviously), but maybe it's a little different with my question because the real data is more complicated than what I illustrated. My data table starts at 4th row (header on 3rd). This code only formats 1 row (above the row that has zero column O value) and what I need is all rows with same column C value are formatted. Please keep in mind that I'm a newbie in vba :(
With Range("A4:r8000").FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND($C4=$C5,$O5=0,$F4<>0)")
.Interior.Color = 13551615
.Font.Color = -16383844
End With
Try this as the formula for the CFR,
=and(countif(c:c, c1)>1, o1=0, len(o1))
'alternate for part that I am not sure I understand
=and(countif(c$1:c1, c1)>1, o1=0, len(o1))
This will go through and highlight duplicate cells if any of the duplicate cells' rows have '0' in column O. I am still working on a way that will make this auto update whenever a change happens in Column O, but can't quite figure that out. Will update when I do.
Sub ConditionalFormatSE()
Application.ScreenUpdating = False
Dim lastRow As Long
Dim myCell As Range
Dim colCVals As Range
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Set colCVals = Range("C1", "C" & lastRow)
colCVals.clearformats
For Each myCell In colCVals
If Cells(myCell.Row, 15).Value = "0" Then
If WorksheetFunction.CountIf(colCVals, myCell.Value) > 1 Then
Set c = colCVals.Find(myCell.Value)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.color = RGB(198, 239, 206)
c.Font.color = RGB(0, 97, 0)
Set c = colCVals.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next myCell
Set colCVals = Nothing
Set myCell = Nothing
Set c = Nothing
Application.ScreenUpdating = True
End Sub
As for making it run automatically, put this in: VBAProject([workbookname].xlsm)->Microsoft Excel Objects->Sheet1([sheetname]) and it should run whenever a value in column 'O' is changed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Columns(15)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call ConditionalFormatSE
End If
Set KeyCells = Nothing
End Sub
If cells with same values are always grouped (one below the other), following code might do what you want.
Sub Test()
Dim lLastRow As Long
Dim i As Integer
lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lLastRow
If ((Worksheets("Sheet1").Cells(i + 1, 3).Value = Worksheets("Sheet1").Cells(i, 3).Value) And (Worksheets("Sheet1").Cells(i, 15).Value = "0")) Then
Worksheets("Sheet1").Cells(i, 3).Interior.Color = vbGreen
End If
Next i
End Sub
What I am trying to do is :
loop through Column Q on Sheet "Global" starting at row 3
For every cell match value to UserForm ComboBox2 Column2, and the copy the entire row to the relevant sheet from userform2 coloum1.
loop though until last row. There could be several unique values in Column Q but will all be in the Userform2's Combobox2 columns.
I have no code as an example as I have no idea where to even begin!
This is my comboxbox, as is displays, on the backing of it each item have the below code, so a name, a code "2780" and a reference "BRREPAIRS".
.AddItem "Repairs"
ComboBox2.List(13, 1) = "2780"
ComboBox2.List(13, 2) = "BRRPEAIRS"
I need it to loop through everycell on the global sheet in column G, then match the cell value to the combobox list item from column 2. Once it has found a match it uses the code from column 1 ie "2780" to copy the entire row to the sheet matching the code in column 1.
Hopefully i have explained it a little better.
Private Sub CommandButton1_Click()
Dim findmatch As Object
Dim lastcell As Integer
Set findmatch = ThisWorkbook.Sheets("Global").Range("G:G").Find(What:=UserForm2.ComboBox2.column(1), LookIn:=xlValues)
If Not findmatch Is Nothing Then
lastcell = ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Cells(100000, 7).End(xlUp).row 'here find a way to locate last cell in sheet that has your name.. it keeps returning me 1 but other than that it works fine
ThisWorkbook.Sheets(UserForm2.ComboBox2.Value).Range(Cells(lastcell, 1), Cells(lastcell, 40)) = Range(Cells(findmatch.row, 1), Cells(findmatch.row, 40)).Value
Else
MsgBox "not found"
End If
End Sub
I have managed to get it to work with the following code below. It looks for the correct cell in the combobox. Then copies it to the correct sheet in the correct position.
The only problem is that it runs very slowley!! Can anyone suggest some way of speeding it up?
And the last question is, having error handling for if a sheet doesn't exists, it tell you to create the sheet, or even create the sheet for you??
I really appreciate all the help guys, have been bashing my head on the wall for days!!!
Dim i, lastD, lastG As Long
Dim j As Integer
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2)
If lookupVal = currVal Then
sheets("Global").Cells(i, "Q").EntireRow.Copy
sheets(Me.ComboBox2.List(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End If
Next j
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
I'm writing a macro that basically draws a circle for every value in a column with a size based on that value, however some of the cells are blank and I just need to skip over them. I run into an error when I hit the first blank cell. Here's the code I have so far:
Sub plotCircles()
Set R = Range("D7:D205")
For Each Value In R
If Value = "" Then
Value = Value + 1
Else
Set shp = ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, Value, Value)
End If
Next Value
End Sub
Try this:
Sub PlotCircles()
Dim r As Range, c As Range, shp As Shape
Set r = Sheet1.Range("D7:D205") 'change to suit
For Each c In r
With c
If .Value <> "" Then
Set shp = Sheet1.Shapes.AddShape _
(msoShapeOval, .Left, .Top, .Value, .Value)
Else
.Value = .Value + 1
End If
End With
Next
End Sub
I don't know why you hardcode your Left and Top argument for the AddShape method.
That will draw all the circles in the same location.
Above however draws the circles in the cell where you get your values from.
You can adjust that to suit your needs. HTH.
With some help, I've put together two functions that will work in unison to first convert all of my data from the "text" format to a "number" format. After which it will set each column to a fixed number of characters.
The two sub-routines I'm using are listed below, but I can't figure out how to omit certain rows/columns for the respective functions.
When running the psAdd function, I want to omit the first 3 rows from the range, and for the FormatFixedNumber function I want to omit several columns. The problem with the latter is that I have 1000+ columns of data and a key header row containing a 1 or 0 that represents whether the column should be converted.
How could modify this code to skip the first 3 rows in the first sub, and several columns marked with a 0 in the second?
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Cells
Set x = Range("A65536").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
Next i
Application.ScreenUpdating = True
End Sub
1. First code
At the moment you are working on all the cells on a sheet with z. You can reduce this to the UsedRange - ignoring the first three rows by
forcing the UsedRange to update before using it (to avoid redunant cells)
testing if the z exceeds 3 rows
if so resize z by three rows using Offset and Resize
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
ActiveSheet.UsedRange
Set z = ActiveSheet.UsedRange
If z.Rows.Count > 3 Then
Set z = z.Cells(1).Offset(3, 0).Resize(z.Rows.Count - 3, z.Columns.Count)
End If
'using Rows is better than hard-coding 65536 (bottom of xl03 - but not xl07-10)
Set x = Cells(Rows.Count,"A").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
2. Second code
Run a simple test on each header cell to proceed if it doesn't equal 0. Assuming that the header cell is in row 1 then
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
If Cells(1, i) <> 0 Then
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
End If
Next i
Application.ScreenUpdating = True
End Sub