so i have this code and what i want to do is the following:
if Range("aj61:aj432") is blank and Range("F61:F432") has text, then set the blank cells to 0
Here is what I tried but got a type mismatch
Sub Insert_0()
Dim rng As Range
Set rng = Range("AJ61:AJ432")
If IsEmpty(rng) And rng.Offset(-30, 0) <> "" Then rng.Value = 0
End Sub
Use SpecialCells to capture the rows from text values in column F intersecting with the blank values in column AJ.
Option Explicit
Sub Insert_0()
Dim rng As Range
On Error Resume Next
Set rng = Intersect(Range("F61:F432").SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow, _
Range("AJ61:AJ432").SpecialCells(xlCellTypeBlanks))
On Error GoTo 0
If Not rng Is Nothing Then
rng = 0
Else
Debug.Print Err.Number & ": " & Err.Description
On Error GoTo -1
End If
End Sub
You need to loop through range:
For i = 61 To 432
If Cells("AJ" & i).Value = "" And Cells("F" & i).Value <> "" Then Cells("AJ" & i).Value = 0
Next
no loops
Sub Insert_0()
Intersect(Range("F61:F432").SpecialCells(xlCellTypeConstants).EntireRow, Range("AJ:AJ")).SpecialCells(xlCellTypeBlanks).Value = 0
End Sub
If you want to check if a range of multiple cells is blank, you need to use something like:
If WorksheetFunction.CountA(rng) = 0 Then
You would have to loop through the cells in the range. Something like:
dim cel as range
for each cel in rng.cells
If IsEmpty(cel) And cel.Offset(-30, 0) <> "" Then cel.Value = 0
next
to make it faster you could fill an array with the values of the range
Related
I would like to copy the first 5 rows (to cell M7) after applying a filter in the table. I have tried a macro found on the internet, but it does not work in any way in my file.
Sub TopNRows()
Dim i As Long
Dim r As Range
Dim rWC As Range
Set r = Range("B16", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each rWC In r
i = i + 1
If i = 5 Or i = r.Count Then Exit For
Next rWC
Range(r(2), rWC).Resize(, 7).SpecialCells(xlCellTypeVisible).Copy Sheet7.[M7]
End Sub
I tried to customize them, where my table has x rows (I operate dynamically) and 7 columns. The headings are in (B15:H15). However, they do not work all the time. The error pops up for me at
Range(r(2), rWC).Resize(, 7).SpecialCells(xlCellTypeVisible).Copy Sheet7.[M7]
Try the following...
Sub TopNRows()
Dim rng As Range
Dim filt As Range
Dim topRows As Range
Dim currentCell As Range
Dim count As Long
Set rng = Range("B15", Range("B" & Rows.count).End(xlUp))
With rng
On Error Resume Next
Set filt = .Offset(1, 0).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible)
If filt Is Nothing Then
MsgBox "No records found!", vbExclamation
Exit Sub
End If
On Error GoTo 0
End With
count = 0
For Each currentCell In filt.Cells
If topRows Is Nothing Then
Set topRows = currentCell
Else
Set topRows = Union(topRows, currentCell)
End If
count = count + 1
If count >= 5 Then Exit For
Next currentCell
topRows.Copy Sheet7.[M7]
End Sub
I've defined a couple of ranges but have problems to define a new range with a few conditions. I'm trying to set a new range from target cell downwards until the length of first TRUE cell is larger than 3 characters. The new desired range would be "Range("C" & Target.Row & ":" & Range("C65536").End(xlDown).Address(0, 0))" but only for the for the cells that have 3 or less characters. The problem with that code is that it stops at the first non-empty cell. The final cell in the range would be the last cell with max 3 characters (and not empty) before a cell value has more than 3 characters.
For instance the new range would be C35:C47 which would then be applied for the adjacent cells as B35:B47. Later on in my code I would then use this new range (B35:B47) in a "for loop" to define new values for these adjacent cells.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim rng As Range, cell As Range
Set rng = Range("B" & Target.Row & ":" & Range("B65536").End(xlUp).Address(0, 0))
Set r = Target
If Target.Column = 3 And Selection.Column = 3 Then
If Intersect(Range("C:C"), r) Is Nothing Then Exit Sub
If r.Value = "" Then Exit Sub
If r.Offset(0, 1).Value <> "" Then Exit Sub
If r.Offset(0, -1).Value <> "" Then Exit Sub
Application.EnableEvents = False
r.Offset(0, -1) = Application.WorksheetFunction.Max(Range("Sheet1!B7:B" & r.Row))
For Each cell In rng
If IsNumeric(cell.Value) Then
If cell.Value <> "" Then
cell.Value = cell.Value + 1
End If
Else
MsgBox "Cell " & cell.Address(0, 0) & " does not have a number"
Exit Sub
End If
Next
Application.EnableEvents = True
End If
End Sub
The new range would then be used in a similar way as the "for-loop" in the example with the difference that "rng" would be the new range --> "For Each cell in rng2"...
I am trying to run through some spreadsheet range and use a try/except in order to build an if/else statement. The reason I am doing this is because IsNumeric() is not working for me so I am trying to do something like this (try except formatting from python)
Dim Temp as Integer
Dim Myrange as Range
Dim Myrow as Range
Set Myrange = Range("A1","A1000")
For Each Myrow in Myrange.Row
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For 'To escape the loop at the end of the filled cells
Else
Try:
Temp = (Myrow.Value() - 0) 'This causes a #VALUE! error when the Myrow.Value is not a number.
Except:
Range("B" & Myrow.Row).Value = Temp 'this sets the value of the rightmost cell to whatever current value of Temp is.
I have also tried some other error catching but can't seem to get it in VBA.
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
Else
On Error Resume Next
Temp = Myrow.Value() - 0
If Err.Number = 0 Then
Range("A" & Myrow.Row).Value = ""
ElseIf Err.Number <> 0 Then
Range("B" & Myrow.Row) = Temp
End If
End If
Next Myrow
I am really just looking to run down the list, see the first number, set value of B0:Bn1 = Temp, when An is hit (new number), The value of Temp changes to temp2 and then cells Bn1+1 -> Bn2-1 is temp2 until a new number is found etc.
in the worksheet I can do it fine with dragging down formula =(A1-0) to see the error message for those that are not numeric but for some reason I can't code it.
Solved this using advice of #MathieuGuindon by using variant type and testing isnumeric on that. Solution code:
Dim Myrange As Range
Dim Myrow As Range
Dim Temp As Variant
Dim NextTemp As Variant
Set Myrange = Selection
For Each Myrow In Myrange.Rows
NextTemp = Range("A" & Myrow.Row).Value
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
ElseIf IsNumeric(NextTemp) Then
Temp = NextTemp
Range("A" & Myrow.Row).Value = ""
Else
Range("B" & Myrow.Row).Value = Temp
End If
Next Myrow
A bit of simplification, and picking up on Mathieu's comments, try this. Not sure what you're doing though so may no be quite right.
Sub x()
Dim Temp As Variant
Dim Myrange As Range
Dim Myrow As Range
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange
If Not IsEmpty(Myrow) Then
Temp = Myrow.Value - 0
If IsNumeric(Temp) Then
Myrow.Value = vbNullString
Else
Myrow.Offset(, 1).Value = Temp
End If
End If
Next Myrow
End Sub
One way is to have a dedicated error handler at the end of your sub, and check the error code (13 for Type Mismatch):
Option Explicit
Public Sub EnumerateValues()
On Error GoTo err_handle
Dim Temp As Integer
Dim Myrange As Range
Dim Myrow As Range
Dim myNumber As Double ' Int? Long?
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For ' to escape loop at end of filled cells
Else
myNumber = CDbl(Myrow.Value())
Debug.Print myNumber
End If
' use label, since VBA doesn't support Continue in loop.
loop_continue:
Next Myrow
exit_me:
Exit Sub
err_handle:
Select Case Err.Number
Case 13 ' Type Mismatch
GoTo loop_continue
Case Else
MsgBox Err.Description, vbOKOnly + vbCritical, Err.Number
GoTo exit_me
End Select
End Sub
This way, if we encounter a value for which CDbl (or the equivalent function) fails, we just continue on to the next row.
While the first example contains Try: and Except: as labels, they provide no error control. Try/Except are vb.net error control methods, not vba.
It's unclear whether you might have text that looks like numbers in column A. If the Temp = (Myrow.Value() - 0) is only meant to determine whether the value in column A is a number and not used as a conversion then SpecialCells can quickly find the numbers in column A.
dim rng as range
on error resume next
'locate typed numbers in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers)
on error goto 0
If not rng is nothing then
rng = vbNullString
End If
on error resume next
'locate text values in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
on error goto 0
If not rng is nothing then
rng.Offset(0, 1) = rng.Value
End If
You can also use xlCellTypeFormulas to return numbers or text returned by formulas.
Consider the following table:
What I would like to be able to do is create something like on the right hand side. This essentially requires telling Excel to sum all values for which the cell is zero until it encounters a 1, at which point it should begin the count again. I imagine this can be done using VBA, so I just need to determine how to actually set up that code. I imagine that the building blocks should be something like this:
Dim row As Long
Dim sum As List
row = Excel row definition
While ColB <> ""
If ColB.value = 0
Append ColC.value to Sum
Else Do Nothing
row = row + 1
Loop
Any help with the structure and syntax of the code would be much appreciated.
Try this:
Sub test()
Dim cel As Range, sRng As Range, oRng As Range, Rng As Range
Dim i As Long: i = 1
On Error GoTo halt
With Sheet1
.AutoFilterMode = False
Set Rng = .Range("B1", .Range("B" & .Rows.Count).End(xlUp))
Rng.AutoFilter 1, 0
Set sRng = Rng.Offset(1, -1).Resize(Rng.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
Rng.AutoFilter 1, 1
Set oRng = Rng.Offset(1, 0).SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
End With
If sRng.Areas.Count >= oRng.Areas.Count Then i = 2
For Each cel In oRng.Areas
If i > sRng.Areas.Count Then Exit For
If cel.Cells.Count = 1 Then
cel.Offset(0, 1).Formula = _
"=SUM(" & sRng.Areas(i).Address(True, True) & ")"
Else
cel.Cells(cel.Cells.Count).Offset(0, 1).Formula = _
"=SUM(" & sRng.Areas(i).Address(True, True) & ")"
End If
i = i + 1
Next
Exit Sub
halt:
Sheet1.AutoFilterMode = False
End Sub
Edit1:
Above works regardless of how many zero's or one's you have in Column B.
If error occurs, it will exit. I leave the coding on how you want the error handled.
This question already has answers here:
Delete Row based on Search Key VBA
(3 answers)
Closed 8 years ago.
Hey guys I am trying to write a code that deletes rows having values that are found using a formula. The problem is every other row is a #VALUE!, which I cannot change due to the setup of the report. In the end I want to delete all rows that have #VALUE! and any row that has values that are less than .75 in Column H.
The code I tried is as shown below:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) < .75 Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub
Any help or tips would be appreciated.
I suggest stepping backwards through the rows so that when a row is deleted you don't lose your place.
Assuming that you want to look at cells contained in column H you could do something like this:
Sub Example()
Const H As Integer = 8
Dim row As Long
For row = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
On Error Resume Next
If Cells(row, H).Value < 0.75 Then
Rows(row).Delete
End If
On Error GoTo 0
Next
End Sub
my code is an alternative to the other answers, its much more efficient and executes faster then deleting each row separately :) give it a go
Option Explicit
Sub DeleteEmptyRows()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim i&, lr&, rowsToDelete$, lookFor$, lookFor2$
'*!!!* set the condition for row deletion
lookFor = "#VALUE!"
lookFor2 = "0.75"
Set ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Range("H" & Rows.Count).End(xlUp).Row
ReDim arr(0)
For i = 1 To lr
If StrComp(CStr(ws.Range("H" & i).Text), lookFor, vbTextCompare) = 0 Or _
CDbl(ws.Range("H" & i).Value) < CDbl(lookFor2) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr) - 1) = i
End If
Next i
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
For i = LBound(arr) To UBound(arr)
rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
Next i
ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
Else
Application.ScreenUpdating = True
MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
Exit Sub
End If
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Set ws = Nothing
End Sub
Try:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range, v As Variant
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
v = cell.Text
If v < 0.75 Or v = "#VALUE!" Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub