During counting blank cells I have an issue due to xlUp.That formula range is working only the cell till that there is a value.For instance let assume that
my range is K9:K208 and I have a 155 blank cells. But if there is any value on K205 than it is count as 152 even if has to be 155.How can I handle this issue?
Sub RoundedRectangle2_Click()
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 11).End(xlUp).Row
Range("A4") = WorksheetFunction.CountIf(Range("K9:K" & lLastRow), "")
End Sub
xlUp is for determining first non-blank cell upwards from starting cell, so Cells(Rows.Count, 11).End(xlUp) will start looking from last row in column K upwards. In your case that will be K208 - that is how you should determine last row (Cells(Rows.Count, 11).End(xlUp).Row).
Having lastRow=208 you can loop starting from 9th row in K column (K9), like
For i = 9 To lastRow and count all blank cells - this will guarantee that you won't miss anything :)
Here's code to get you started:
Sub CountBlanks()
Dim i, lastRow As Long
lastRow = Cells(Rows.Count, 11).End(xlUp).Row
For i = 9 To lastRow
'check if cell is blank and do any other operations
Next
End Sub
Here is an alternate method of locating a 'last row' across many columns.
dim lastRow as long
with worksheets("sheet1")
lastRow = .cells.find("*", after:=.cells(1), _
searchorder:=xlbyrows, searchdirection:=xlprevious).row
.Range("A4") = WorksheetFunction.CountIf(.Range("K9:K" & lastRow), "")
end with
Related
I'm looking to update a cell on a sheet when it's left empty. If there is data in column B but not in column AA, I need to insert something into column AA.
I have made the following code but have failed to make it update the cell:
Range("B2").Select
Do Until IsEmpty(ActiveCell)
Dim LoopRowNo As Integer
LoopRowNo = ActiveCell.Row
If IsEmpty(Range(Cells(LoopRowNo, 26))) Then Range(Cells(LoopRowNo, 26)).Value = "01/01/1990"
ActiveCell.Offset(1, 0).Select
Loop
Hoping someone can point me in the right direction.
Use Range or Cells, but not both.
Don't Select.
With ActiveSheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Dim i As Long
For i = 2 to lastRow
If IsEmpty(.Cells(i, "AA")) And Not IsEmpty(.Cells(i, "B")) Then
.Cells(i, "AA").Value = "01/01/1990"
End If
Next
End With
If cell in column I1-I14 is greater than cell in column J1-J14, I want to cut the entire row and paste values to the first empty row. (From row 16 and down.)
If cell i is greater than cell j, cut row and paste values to first empty row (row 16 in this example)
This code just pastes in the first row:
Sub Knapp6_Klicka()
Dim i As Long
Dim j As Long
j = 1
For i = 3 To 500
If Cells(i, 9).Value > Cells(i, 10).Value Then
Cells(i, 12).EntireRow.Cut Sheets("Blad1").Range("A" & j)
j = j + 1
End If
Next i
End Sub
I tried to combine the paste with two different solutions.
One like this, where I recorded a macro and went to the last cell, then up to the first empty cell:
Range("A1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
And one solution that I found on an Excel community:
Sub compareresult()
Dim row1 As Integer
Dim row2 As Integer
row2 = 1
For row1 = 8 To 500
If sheet1.Cells(row1, 11).value > sheet1.Cells(row1, 9).value Then
sheet1.Cells(row1, 1).EntireRow.Copy Sheets(11).Cells(row2, 1)
row2 = row2 + 1
End If
Next row1
End Sub
If cell in column I1-I14 is greater than cell in column J1-J14, i want to cut entire row and paste values to the first empty row. (From row 16 and down)
Here is a method which doesn't cut and paste in a loop. Since you are not deleting the row or "cutting and inserting" the row, here is a simple approach. The below code follows a basic logic
Logic
Loop and identify the range.
If found, then copy the range in 1 go.
Finally clear the range which was copied (if copied).
Code
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim i As Long
'~~> Change this to relevant sheet
Set ws = Sheet1
With ws
'~~> Loop and identify the range
For i = 2 To 14
If .Range("I" & i).Value2 > .Range("J" & i).Value2 Then
If rngToCopy Is Nothing Then
Set rngToCopy = .Rows(i)
Else
Set rngToCopy = Union(rngToCopy, .Rows(i))
End If
End If
Next i
'~~> If found then copy and clear
If Not rngToCopy Is Nothing Then
rngToCopy.Copy .Rows(16)
rngToCopy.Clear
End If
End With
End Sub
EDIT:
To incorporate new edits
Works perfectly! Thanks! :) I failed to fully describe my problem.. What i also need is to paste it as special (only paste the value and not the formulas). Do you got any quick solution for that? – Johl 5 hours ago
Replace
rngToCopy.Copy .Rows(16)
to
rngToCopy.Copy
DoEvents
.Rows(16).PasteSpecial Paste:=xlPasteValues
Have a try with this.
It's based on the range you gave. Skipped over row 1 since you have headers in it.
Dim i As Long, lRow As Long, ws As Worksheet
Set ws = Sheets("Blad1") 'Your sheet name
lRow = ws.Range("I" & Rows.Count).End(xlUp).Row + 1 'Finding the last row
If lRow < 16 Then lRow = 16 'The starting row you want to cut to
For i = 2 To 14 'Your range of rows to check
If ws.Range("I" & i) > ws.Range("J" & i) Then
ws.Range("I" & i).EntireRow.Cut ws.Range("A" & lRow) 'Cutting the whole row so you use column A to cut to
lRow = lRow + 1 'Move down 1 row for where to cut to
End If
Next i
Edit:
Because you only want the values to copy accross we can't use Cut and PasteSpecial xlValues so instead we will duplicate the value of the entire row to the new location, then clear the row (filling in for the cutting part). If clear is too much we can just ClearContents to remove the values in the cells instead of the formatting if that happens. Make sure to always save before running VBA code for the first time.
Dim i As Long, lRow As Long, ws As Worksheet
Set ws = Sheets("Blad1") 'Your sheet name
lRow = ws.Range("I" & Rows.Count).End(xlUp).Row + 1 'Finding the last row
If lRow < 16 Then lRow = 16 'The starting row you want to cut to
For i = 2 To 14 'Your range of rows to check
If ws.Range("I" & i) > ws.Range("J" & i) Then
ws.Range("A" & lRow).EntireRow.Value = ws.Range("I" & i).EntireRow.Value 'Copying the values over
ws.Range("I" & i).EntireRow.Clear 'Clear the row
lRow = lRow + 1 'Move down 1 row for where to cut to
End If
Next i
Your code is doomed to failure because you do not take into consideration that you are cutting the found row. Think about what that means. Your row with the In,Out is row 15 and you wish to paste to row 16. If you cut row 5 (for example) then rows 15 and 16 will become rows 14 and 15. It also means that your next row (which you think will be row 6) will actually be what was row 7 before the cut.
I am trying to sort a range of cells without hardcoding the starting and stopping points. My range will always start in column A and span to column M, however the rows it stops and starts on will vary. I figured out how to set a variable and incorporate it into the Range function for the last-row, but I can't figure out how to do that for the row the range should start on. Here is my code so far:
Range("A6:M" & lastRow).Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlNo
This works only if I start my range on row 6. What I can't figure out is how to tell excel to start my range on the first row that is not blank in column A.
Thanks!
Determine if A1 is blank. Use A1 if not blank and the [ctrl]+[down] if it is blank.
dim startRow as long, lastRow as long
With worksheets("sheet1")
lastRow = .cells(.rows.count, "M").end(xlup).row
if isempty(.cells(1, "A") then
startrow = .cells(1, "A").end(xldown).row
else
startRow = 1
end if
with .range(.cells(startrow, "A"), .cells(lastrow, "M"))
.cells.Sort Key1:=.cells(1), Order1:=xlAscending, Header:=xlNo
end with
end with
I'm at a loss on this and need some help. I've lurked around at answers and have Frankensteined together some code for a macro but it just isn't working.
Here is part of what I have so far:
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
With .Cells(lrow, "G")
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
Next lrow
End With
I have a very similar block of code before this that deletes crap from the text files I'm importing and it works perfectly through all the number of rows. When I run the same thing with this formula, it only puts the formula in G1 and doesn't cycle through the rest of the sheet. I've tried this and it works, but copies down through all million plus rows:
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Selection.AutoFill Destination:=Range("G:G")
I've tried this and then run the same code that gets rid of the text file crap but I get an error "End If without block If".
To fill the formula in one cell at a time you need to cycle through them; don't keep relying on the ActiveCell property.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
.Cells(lrow, "G").FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Next lrow
End With
But you can speed things up by putting the formula into all of the cells at once.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(.Cells(Firstrow, "G"), .Cells(Lastrow, "G"))
.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
End With
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Another version, to dynamically select the columns based on their titles. Comments included.
Dim row As Range
Dim cell As Range
Static value As Integer
'Set row numbers
'Find the starting row. Located using Title of column "Start" plus whatever number of rows.
Dim RowStart As Long
Set FindRow = Range("A:A").Find(What:="Start", LookIn:=xlValues)
RowStart = FindRow.row + 1
'End of the range. Located using a "finished" cell
Dim RowFinish As Long
Set FindRow = Range("A:A").Find(What:="Finished", LookIn:=xlValues)
RowFinish = FindRow.row - 1
'Set range - Goes Cells(Rownumber, Columnnumber)
'Simply ammend RowStart and RowFinish to change which rows you want.
' In your case you need to change the second column number to paste in horizontally.
Set rng = Range(Cells(RowStart, 1), Cells(RowFinish, 1))
'Start the counter from the starting row.
value = RowStart
For Each row In rng.Rows
For Each cell In row.Cells
'Insert relevant formula into each cell in range.
cell.Formula = _
"=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
'Increment row variable.
value = value + 1
Next cell
Next row
I have a file of some 500-600 lines (with great potential to grow). It started as an xml file and after an auto-read the table created has a varying number of blank cells between the header information and the remainder. The same amount of information exists per line. I need each line to contain contiguous data.
Imagine the yellow squares are cells with information. The top grid is how it comes to me. The middle is how desperately need it. The last is an ideal wherein the remaining table-formatted columns go away (also something I know how to do rather easiily).
I would appreciate any and all help.
Not sure I understand the real requirement, but if you start with data like:
and you select the cells in column A for the rows you want to process and run this:
Sub FixLines()
Dim r As Range, N As Long, i As Long, RR As Long
For Each r In Selection
RR = r.Row
N = Cells(RR, Columns.Count).End(xlToLeft).Column
If N <> 1 Then
For i = N To 1 Step -1
If Cells(RR, i).Value = "" Then
Cells(RR, i).Delete (xlShiftToLeft)
End If
Next i
End If
Next r
End Sub
You will end up with:
Here is one way to do it (you could also use code to just move content to the left).
Option Explicit
Function Delete_Blank_Cells()
Dim lRow As Long
Dim lCol As Long
Dim LastRow As Long
Dim LastCol As Long
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
For lRow = 1 To LastRow
For lCol = 1 To LastCol
If Cells(lRow, lCol) = "" Then
Cells(lRow, lCol).Delete Shift:=xlToLeft
End If
Next
If lRow > 5 Then
MsgBox "Exit code - remove after testing!!"
Exit Function
End If
Next
End Function