I want to check text in a range of cells, Columns A to L and Rows 2 to 10, I want to use a for to go through that range, but I get an error
For x = 1 To 12 Step 1
For i = 2 To 10 Step 1
If Range(x, i).Value = "#REF!" Then
Range(x, i) = "0"
End If
Next
Next
Multiple issues:
Use Cells instead of Range.
Test if the cell contains a #REF! error
For x = 1 To 12 Step 1
For i = 2 To 10 Step 1
If IsError(Cells(x, i).Value) Then
If Cells(x, i).Value = CVErr(xlErrRef) Then
Cells(x, i).Value = 0 '<--- no quotes, write a number not a string
End If
End If
Next
Next
No need to use numerical loop, you can use structure like this, if you want to detect all #REF errors and replace them with zero.
Sub test()
Dim itm As Variant
For Each itm In Range("A2:L10")
If IsError(itm.Value) Then
If itm.Value = CVErr(xlErrName) Then itm.Value = 0
End If
Next itm
End Sub
Related
I Have 10 columns in an Excel table, and I want to delete the rows where the first 7 cell is empty.
I've tried to do it this way:
Sheet1.Range("Table4[variable1, variable2, variable3, variable4, variable5, variable6, variable7]").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
but It doesn't work. Am I have to use nested for loop for rows and columns?
You can loop trough each row directly, and check if the first 7 cells of that row in your table are empty. If true, delete them.
Dim MyTable As ListObject
Dim i As Long
Set MyTable = ActiveSheet.ListObjects("Table4")
With MyTable.DataBodyRange
For i = .Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountBlank(.Range(Cells(i, 1), Cells(i, 7))) = 7 Then .Rows(i).Delete
Next i
End With
The good point about this way is that if your table changes address, it still will work. You would only need to update if you want to check a different name of cells (seven rght now) or if the condition (7 first cells empty) changes.
Broadly speaking yes. Loop down the rows you want to check,
For rowcounter = 1 to 10 'whatever rows you want
use the test
If Application.WorksheetFunction.CountA("A" & rowcounter & ":G" & rowcounter) = 0 Then
(I assume first 7 columns meant A to G), and then
Rows(rowcounter).Delete
You don't need multiple loops. A single loop with the use of the IsEmpty() function should work:
Option Explicit
Sub Test()
Dim i As Long
For i = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If IsEmpty(Sheet1.Cells(i,1)) And IsEmpty(Sheet1.Cells(i,2)) And IsEmpty(Sheet1.Cells(1,3)) And _
IsEmpty(Sheet1.Cells(i,4)) And IsEmpty(Sheet1.Cells(i,5)) And _
IsEmpty(Sheet1.Cells(i,6)) And IsEmpty(Sheet1.Cells(i,7)) Then
Sheet1.Rows(i).Delete
End If
Next i
End Sub
I guess that this simple snippet, full of unnecessary procedures, can help you:
Sub NotTested()
' Choose below the rows range
first_row = 2
last_row = 4242
For r = last_row To first_row Step -1
' Checking below each column (from row r) value
a_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 1).Value2
b_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 2).Value2
c_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 3).Value2
d_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 4).Value2
e_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 5).Value2
f_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 6).Value2
g_value = ThisWorkbook.Sheets("Sheet1").Cells(r, 7).Value2
' Comparing if the columns are actually empty
If a_value = "" And b_value = "" And c_value = "" And d_value = "" And e_value = "" And f_value = "" And g_value = "" Then
ThisWorkbook.Sheets("Sheet1").Cells(r, 1).EntireRow.Delete
End If
Next r
End Sub
Here's a simple solution that actually counts the number of rows in a table then deletes if the first 7 columns are blank.
Sub deleteEmptyRows()
Set tbl = ActiveSheet.ListObjects("Table4")
For I = 1 To tbl.Range.Rows.Count
If WorksheetFunction.CountA(Range("A" & I & ":" & "G" & I)) = 0 Then
Sheets("Sheet1").Rows(I).EntireRow.Delete
End If
Next I
End Sub
Trying to loop through a sheets"data".Range"AM1:AS12" and copy the data to range beginning at BD1 as long as the data doesn't equal "#N/A"
My code works with copying the first column, but doesn't do anything with the data after that. Where am I going wrong?
Set S2 = Sheets("data").Range("AM:AM")
Set S3 = Sheets("data").Range("BD:BD")
Dim i As Integer, j As Integer
j = 1
For i = 1 To 12
If S2.Cells(i, 1).Value <> "#N/A" Then
S3.Cells(j, 2).Value = S2.Cells(i, 1).Value
j = j + 1
End If
Next i
Replace:
<> "#N/A"
By:
Not(Application.WorksheetFunction.IfNa(...))
This works when i tested it.
Sub CopyCell()
Set S2 = Sheets("data").Range("A:A")
Set S3 = Sheets("data").Range("M:M")
Dim i As Integer, j As Integer
For j = 1 To 2
For i = 1 To 12
If S2.Cells(i, j).Value <> "#N/A" Then
S3.Cells(i, j).Value = S2.Cells(i, j).Value
End If
Next i
Next j
Call DeleteBlank
End Sub
Sub DeleteBlank()
Dim x As Integer
Dim y As Integer
For y = 13 To 16 'Range numbers for the columns the data is copied to
For x = 1 To 10 ' Number of cells of data you want to loop through
If Cells(x, y).Value = "" Then
Cells(x, y).Delete Shift:=xlUp
End If
Next x
Next y
End Sub
the best thing to is not to check if it is equal to "#N/A"
The best is to check if it is an error : If Not (IsError(S2.Cells(i, 1).Value)) Then
I have two columns of data on the same worksheet.
I want to compare all the values in column B to the last value in column A. If they are the same, call a certain function. Then move to the next value in column A, and compare to all values in B again, etc.
Sub FindSamples()
Dim first As String
Dim second As String
Dim j As Long
Dim i As Long
Dim lastRowNumber As Long
Dim lastRowNumberDDH As Long
With Sheets("Shape Point Info")
lastRowNumber = .Cells(Rows.Count, 1).End(xlUp).Row
lastRowNumberDDH = .Cells(Rows.Count, 20).End(xlUp).Row
For i = lastRowNumberDDH To 0 Step -1
For j = lastRowNumber To 0 Step -1
second = Cells(j, 4).Value
first = Cells(i, 20).Value
If first = second Then
'Call something
Worksheets("Shape Point Info").Range("J14").Value = "Yes"
Else:
End If
Next j
Next i
End With
End Sub
My errors are on lines 17 and 18 of my code:
second = Cells(j, 4).Value
first = Cells(i, 20).Value
I get
"Run time error 1004: Application-defined or object-defined error"
Cells, Rows, Columns, and almost all collections and items in VBA are 1-indexed. Therefore you cannot access Rows(0), and this is the issue with your code. You have to amend your For lines as such:
For i = lastRowNumberDDH To 1 Step -1
For j = lastRowNumber 1 Step -1
My code copies a text from a cell in Matrix 1 to all the cells that meet my criteria in Matrix 2. But I want it to copy it only to the first cell that meets my critiria in Matrix 2 and then stop.
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
For j = 2 To 2
For i = 21 To 21
If Cells(i, j).Value > 0 Then
Cells(i, j).Value = Cells(i, j).Value - 1
Cells(i, j).Offset(0, -1).Select
End If
'as it says - for EACH - so it copies in aLL the cells'
'I can't Change the range though, cause there will come a Loop eventually'
For Each cell In Range("a1:aap15")
If cell.Interior.ColorIndex = 6 Then
If cell.Value = "" Then
cell.Value = ActiveCell.Value
End If
End If
Next
Next
Next
End Sub
You can use the Exit For command to exit a for loop. It looks like you want to add it here:
If cell.Interior.ColorIndex = 6 Then
If cell.Value = "" Then
cell.Value = ActiveCell.Value
Exit For
End If
End If
Note: not tested. Let me know if you have any problems
My code mostly works but it's taking a while to debug so I am beginning to think my architecture may be flawed XD So how can I architect this better?
I have groups of data separated by a blank row. You can tell each group apart by the ID in column C in addition to the blank row. For each ID, I have various numbers in column B that I need to capture. Sometimes those numbers only start with 5, sometimes it starts with 7. I need to capture the 5 and the 7 separately.
With projWS
With .Range("C1:C6000")
Set f = .Find(cc, LookIn:=xlValues, lookat:=xlPart)
End With
If Not f Is Nothing Then 'first occurence found
counter = 0
i = f.Row
Do
acct = .Cells(i, 2)
If (Len(projWS.Cells(i, 3)) < 1 Or Left(acct, 1) = "7") And done = False Then
acctStart = f.Row
acctRows = i - acctStart
Set acctRng = .Range(.Cells(acctStart, 2), .Cells(i - 1, 5))
Set amountRng = .Range(.Cells(acctStart, 7), .Cells(i - 1, 8))
done = True 'set flag to show range has been filled
End If
counter = counter + 1 'increment counter
i = i + 1 'move to next row
Loop Until Len(.Cells(i, 3)) < 1 'keep looping until blank row
End If
If counter - 1 > acctRows Then 'how we determine if there's a "7"
flag = True 'so we set flag to true
Set depreRng = Range(.Cells(acctStart + acctRows, 2), .Cells(i - 1, 8))
dep = depreRng.Value2 'store range into array
End If
End With
After capture, I need to drop it into another worksheet. This worksheet already has a block of 7 built in. Hence this is the loop I am using to drop the range of 7. There is no built in block for the 5.
For r = 112 To 120
For k = 1 To UBound(dep())
If .Cells(r, 1).Value2 = Trim(dep(k, 1)) Then
Debug.Print .Cells(r, 1).Value2
.Cells(r, 6) = dep(k, 6)
.Cells(r, 7) = dep(k, 7)
Exit For
Else
.Cells(r, 6) = 0
.Cells(r, 7) = 0
End If
Next k
Next r
I have debugged several errors already. The current one is that depreRng is breaking because my math is bad. Instead of debugging each error as I stumble onto it, how can I architect this better?
Ok, my approach it's different. First i use a filter for find the range of rows with the index you are looking for and then loop inside this filtered rows for find the 5xx and the 7xx range. The code:
Sub Macro1()
Dim rng_5xx_start, rng_5xx_stop, rng_7xx_start, rng_7xx_stop As Integer
rng_5xx_start = 0
rng_5xx_stop = 0
rng_7xx_start = 0
rng_7xx_stop = 0
Dim range_5xx, range_7xx As String
'filter for the index you are looking for
'specify the maximum range, the field is the "offset" from the column B (the firts of the range), so for filter for column C you need to put 2, criteria...is the critera :)
ActiveSheet.Range("$B$1:$H$6000").AutoFilter Field:=2, Criteria1:="b"
'the filter returns only the rows with the specifyed index, now a for inside this rows for find the 5xx and the 7xx sub-ranges
For Each Row In ActiveSheet.Range("b1:b6000").SpecialCells(xlCellTypeVisible)
If Cells(Row.Row, 2).Value > 4999 And Cells(Row.Row, 2).Value < 6000 Then
'or any test for understnd if i'm in the 5xx range, if you prefer use the strings use something like left(cells(row.row,2).value,1) = "5"
If rng_5xx_start = 0 Then 'found the first row with a 5xx value
rng_5xx_start = Row.Row 'set the start of the range to this row
End If
If rng_5xx_stop < Row.Row Then 'the row where i am is in the 5xx range and is grater than the current end i noticed
rng_5xx_stop = Row.Row 'refresh the end of the range...at the end this will have the last number of row of the 5xx range
End If
End If
If Cells(Row.Row, 2).Value > 6999 And Cells(Row.Row, 2).Value < 8000 Then
'same as above but for 7xx range
If rng_7xx_start = 0 Then
rng_7xx_start = Row.Row
End If
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
End If
Next
If rng_5xx_start = 0 Then
'not found 5xx rows
range_5xx = "" 'or False, or what you prefer...
Else
range_5xx = "B" & rng_5xx_start & ":H" & rng_5xx_stop
End If
If rng_7xx_start = 0 Then
'not found 7xx rows
range_7xx = "" 'or False, or what you prefer...
Else
range_7xx = "B" & rng_7xx_start & ":H" & rng_7xx_stop
End If
End Sub
That's how i would imagine a macro for your job ;)
Edit 1:
I forgot that this will leave the sheet with the filter on...use activesheet.showalldata for show all the rows and not only the filtered ones
Edit 2:
The tests
If rng_5xx_stop < Row.Row Then
rng_5xx_stop = Row.Row
End If
and
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
are not necessary, it's enough do rng_5xx_stop = Row.Row and rng_7xx_stop = Row.Row and save the two IF statements
You are grouping cells based on the first number of the cell values in column B (I am assuming that they can never be letters). If that is the case, then you can create an array of 0 to 9 and store your ranges in there. Then go through the range.areas in order to get the groupings you're looking for (as highlighted in your screenshot).
To do this, something like this is all you need. I commented code to try to explain it more:
Sub tgr()
Dim wsData As Worksheet
Dim rColB As Range
Dim BCell As Range
Dim aRanges(0 To 9) As Range
Dim SubGroup As Range
Dim lRangeNum As Long
Dim i As Long
'Change to your actual worksheet
Set wsData = ActiveWorkbook.ActiveSheet
'Change to your actual column range, this is based off the sample data
Set rColB = wsData.Range("B1", wsData.Cells(wsData.Rows.Count, "B").End(xlUp))
'Loop through the column range
For Each BCell In rColB.Cells
'Make sure the cell is populated and the starting character is numeric
If Len(BCell.Value) > 0 And IsNumeric(Left(BCell.Value, 1)) Then
'Get the starting digit
lRangeNum = Val(Left(BCell.Value, 1))
'Check if any ranges have been assigned to that array index location
'If not, start a range at that array index
'If so, combine the ranges with Union
Select Case (aRanges(lRangeNum) Is Nothing)
Case True: Set aRanges(lRangeNum) = BCell
Case Else: Set aRanges(lRangeNum) = Union(aRanges(lRangeNum), BCell)
End Select
End If
Next BCell
'You can use any method you want to access the ranges, this just loops
'through the array indices and displays the range areas of each
For i = 0 To 9
If Not aRanges(i) Is Nothing Then
For Each SubGroup In aRanges(i).Areas
'Do what you want with it here
'This just selects the subgroup so you can see it found the groups properly
SubGroup.Select
MsgBox SubGroup.Address
Next SubGroup
End If
Next i
End Sub
I see you've allready rewritten your code, but I'd like to offer how I would do it and would like to know your thoughts about it. Would this be inefficient? I guess it could be because you have to read the first character in cells 4 times for every increment, but not shure if that is a big problem.
Dim start_row As Long
Dim end_row As Long
start_row = 1
end_row = 0
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i - 1, 2) = "" Then
start_row = i
ElseIf Left(Cells(i - 1, 2), 1) <> Left(Cells(i, 2), 1) Then
start_row = i
End If
If Cells(i + 1, 2) = "" Then
end_row = i
ElseIf Left(Cells(i + 1, 2), 1) <> Left(Cells(i, 2), 1) Then
end_row = i
End If
If end_row <> 0 Then
Call copy_range(start_row, end_row)
end_row = 0
End If
Next i
Another approach that lets you only read the character once could be
Dim start_row As Long
Dim end_row As Long
Dim char_above As String
Dim this_char As String
start_row = 1
end_row = 1
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 2) = "" Then
end_row = i - 1
if i <>1 then Call copy_range(start_row, end_row,char_above)
start_row = i + 1
Else
this_char = Left(Cells(i, 2), 1)
If this_char <> char_above Then
end_row = i - 1
if i<> 1 then Call copy_range(start_row, end_row,char_above)
start_row = i
End If
char_above = this_char
End If
Next i
Let me know your thoughts.