I am trying to delete blank rows in a range
My code looks like this :
Dim rng As Range
Dim i As Long, counter As Long
i = 1
Range("B1").Select
Selection.End(xlDown).Offset(0, 5).Select
Set rng = Range("G2", ActiveCell)
Range("G2").Select
For counter = 1 To rng.Rows.Count
If rng.Cells(i) = "" Then
rng.Cells(i).EntireRow.Delete
Else
i = i + 1
End If
Next
So, hmqcnoesy has kindly helped me solve the error message. The variables should be Dimmed as LONG not INTEGER because integer can not hold as big a number for all my rows of data
Also, Jon49 gave me some code that was much mroe efficient for this process:
Dim r1 As Range 'Using Tim's range.
Set r1 = ActiveSheet.Range(Range("G2"),Range("B1").End(xlDown).Offset(0, 5))
'Delete blank cell rows.
r1.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set r1 = Nothing
It looks like you should try using type Long for i and counter. Using Integer causes an overflow, at least in newer versions of Excel, where there are over 1 million rows in a worksheet.
Here's some simpler code for you:
Dim r1 As Range
'Using Tim's range.
Set r1 = ActiveSheet.Range(Range("G2"),Range("B1").End(xlDown).Offset(0, 5))
'Delete blank cell rows.
r1.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set r1 = Nothing
Dim rng As Range
Dim counter As Long
Set rng = Range(Range("G2"),Range("B1").End(xlDown).Offset(0, 5))
For counter = rng.Rows.Count to 1 Step -1
If Len(rng.Cells(counter).Value) = 0 Then rng.Cells(counter).EntireRow.Delete
Next
Related
I would like to create a table using excel/vba similar to the image posted.
Below is the code I have.
Dim nextRowAs Range
For i = 1 To N
Set nextRow= ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
nextRow.PasteSpecial xlPasteAll
Set nextRow1= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-3, 0)
nextRow.Value = 0
Set nextRow2= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-2, 0)
nextRow2.Value = 0
Set nextRow3= ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(-1, 0)
nextRow3.Value = 0
I defined section 1 as a Named range and am copy and pasting it to the bottom, clearing the user input as I go.
What I need guidance on.
This code pastes each range to the bottom. I would like to paste it like the image, left to right first then top to bottom with 2 per row.
Like this - looks a little complex maybe, but it's best to break your code into modular parts:
Sub Tester()
Dim n As Long
For n = 1 To 10
CreateArea n
Next n
End Sub
Sub CreateArea(areaNum As Long)
With AreaRange(areaNum)
AreaRange(1).Copy .Cells(1)
.Cells(1, 1).Value = areaNum
ResetArea .Cells
End With
End Sub
Sub ResetArea(rngArea As Range)
rngArea.Cells(2, 2).Resize(3, 1).ClearContents
End Sub
'return the range for supplied area number
Function AreaRange(areaNum As Long) As Range
Const RNG1 As String = "E2:F6" 'first area
Const PER_ROW As Long = 2 'two blocks per row
Dim r1 As Range, rwOff As Long, colOff As Long, c As Range
Set r1 = ActiveSheet.Range(RNG1) 'or set a specific sheet
'calculate offsets for the area to be created (adding 1 empy row/column between areas)
rwOff = Application.Floor((areaNum - 1) / PER_ROW, 1) * (r1.Rows.Count + 1)
colOff = ((areaNum - 1) Mod PER_ROW) * (r1.Columns.Count + 1)
Set AreaRange = r1.Offset(rwOff, colOff) 'return the offset range
End Function
I wrote a program using VBA which shown below. there was an array(ary) which contain(C,F,B,PC,PB). I create the loop to go through each variable in the array.
what I want to do with my code is I have a datasheet that includes that array values as categories. I want to assign each array values to p range. then execute data from the p range. then want to assign p to next array value and do the same.
but the problem is range p is firstly set ary(1)="C" and give the correct result. but after it becomes equal to "F" didn't work properly. it contains the same range previously gave. can anyone help me with this problem?
For i = 1 To UBound(ary)
cat = ary(i)
Set p = Nothing
Set c = Nothing
For Each c In Range("E:E")
If c.Value = cat Then
If p Is Nothing Then
Set p = c.Offset
Else
Set p = Union(p, c)
End If
End If
Next c
'get values
p.Offset(, -1).Copy Destination:=ws.Range("N" & Rows.Count).End(xlUp).Offset(1)
next i
The key error in your code is the idea that you might collect a range of non-consecutive cells and paste their value into a contiguous range. Excel can't do that. My code below collects qualifying values into an array and pastes that array into the target range.
The code below can't be exactly what you want because you didn't provide some vital information. However, please try it anyway with the aim of adapting it to your project.
Private Sub Review()
Dim Ws As Worksheet
Dim Rng As Range
Dim Rl As Long ' last row in column E
Dim Ary() As String
Dim Arr As Variant
Dim n As Long
Dim Cell As Range
Dim i As Long
Set Ws = Worksheets("Sheet1")
Ary = Split("C,F,B,PC,PB", ",") ' this array would be 0-based
Rl = Cells(Rows.Count, "E").End(xlUp).Row ' Range("E:E") has 1.4 million cells
Set Rng = Range(Cells(2, "E"), Cells(Rl, "E"))
For i = 0 To UBound(Ary)
ReDim Arr(1 To Rl)
n = 0
For Each Cell In Rng
If Cell.Value = Ary(i) Then
n = n + 1
Arr(n) = Cell.Offset(0, 1).Value
End If
Next Cell
If n Then
ReDim Preserve Arr(n)
'get values
Ws.Cells(Ws.Rows.Count, "N").End(xlUp).Offset(1) _
.Resize(UBound(Arr)).Value = Arr ' Application.Transpose(Arr)
End If
Next i
End Sub
This code works entirely on the ActiveSheet and then pastes the result to another sheet, named as "Sheet1". That isn't good practice. The better way would be to declare variables for both sheets and let the code refer to the variables so as to ensure that it has full control of which sheet it's working on at all times.
Set p = Union(p, c) will never be executed because it will only occur if p is NOT nothing, and Set p = Nothing is executed each time the outer loop iterates.
Hi this is my first post and i am newbie when it comes to VBA.
So i tried the last 6 hours to accomplish one task.
I already managed to get the code for the For each loop and it works and copies the value to the existing workbook. But i couldnt find out why it always copies the value to A2 and not further to A3/A4/A5 and so on .
I tried these piece of code " range = range + 1 " but i keep getting runtime errors and it still copies the values to A2 and overwrites it when it gets a new value from the loop.
I think its only a litte change needed but i cant figure it out. :(
Sub copie1()
Dim ws As Worksheet
Dim cell As Range
Dim targetsheet As Worksheet
Dim target As Range
Dim rngTemp As Range
Set wkba = ActiveWorkbook
Worksheets("cop1").Activate
LR = Cells(Rows.Count, "A").End(xlUp).Row
LT = Cells(Rows.Count, "X").End(xlUp).Row
Set rngTemp = Range("X2:X" & LT)
Workbooks.Open Filename:="C:\Users\path......."
Set targetsheet = Worksheets("Data")
Set target= targetsheet.Range("A1")
For Each cell In rngTemp
If cell > 0 Then
target.Offset(1, 0) = cell.Value
End If
target = target+1 '// is this right?
Next cell
End Sub
my goal is the loop through column X in a Workbook and copy every single data that is bigger than 0 ( because there are empty cells & cells with value 0)
and paste it in an existing workbook in range A2/A3/A4 and so on
You can't add the number one to a Range object.
Try replacing target = target+1 '// is this right? with:
Set target = target.Offset(1)
Does this resolve the problem?
SibSib1903, I have added below a simple example that you can easily adapt to your own requirements. It looks at all cell values in column A and any numeric value greater than zero is copied to column C starting in row 1. For example, if column A contains 45 rows with data, and only three of these rows have a numeric value greater than zero, these three values will copied in column C in the first three rows.
Public Sub copieTest()
Dim ws As Worksheet, cell As Range, rngX As Range
Dim tmpVal As Variant, counter As Long
Set ws = ThisWorkbook.Worksheets("cop1")
Set rngX = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
counter = 1
For Each cell In rngX
tmpVal = Val(Trim(cell.Value))
If tmpVal > 0 Then
ws.Range("C" & counter).Value = tmpVal
counter = counter + 1
End If
Next cell
Set rngX = Nothing: Set ws = Nothing
End Sub
I am looping through a row of cells and trying to assign the values in these cells to an array, but this is resulting in a Type Mismatch error. The relevant bits of my code are below:
Dim queryaddress As Range
Dim notoffsetnum As Integer
Dim anotherarrayofnumbers() As Integer
Dim c As Range
For Each queryaddress In worksheetname.Range("B2:B21")
Set queryrow = queryaddress.EntireRow
notoffsetnum = 0
For Each c In queryrow
If c.Interior.Color <> 192 And Not IsEmpty(c.Value) Then
notoffsetnum = notoffsetnum + 1
ReDim Preserve anotherarrayofnumbers(notoffsetnum)
anotherarrayofnumbers(notoffsetnum) = c.Value
'The above line errors
End If
Next c
Next queryaddress
A for each loop loops through a collection. You have a range called query row. You have a range called c. What you've done is loop through every RANGE in queryrow...which means c will just be query row.
You want
for each c in queryrow.cells
Also, be aware that's about as inefficient as possible since it's going to loop through all 65000 or so columns, instead of just the comparatively few that actually have data.
EDIT: I'm not sure why that's still getting you an error. You have other logical errors though. This executes for me (also, for the love of goodness, indenting!), if I throw in some data from B2:H21, for example:
Sub test()
Dim worksheetname As Worksheet
Set worksheetname = ActiveWorkbook.ActiveSheet
Dim queryaddress As Range
Dim notoffsetnum As Integer
Dim anotherarrayofnumbers() As Integer
Dim c As Range
For Each queryaddress In worksheetname.Range("B2:B21")
Dim queryrow As Range
Set queryrow = queryaddress.EntireRow
notoffsetnum = 0
For Each c In queryrow.Cells
If c.Interior.Color <> 192 And Not IsEmpty(c.Value) Then
notoffsetnum = notoffsetnum + 1
ReDim Preserve anotherarrayofnumbers(notoffsetnum)
anotherarrayofnumbers(notoffsetnum - 1) = c.Value
End If
Next c
Next queryaddress
Dim i As Integer
For i = 0 To UBound(anotherarrayofnumbers) - 1
Debug.Print anotherarrayofnumbers(i)
Next i
End Sub
One other problem that was easy to fix is that be default, VBA arrays are 0-based. They start at 0, and you were erroneously starting at 1. VBA won't throw an error, it'll just have element 0 be 0.
Your real problem is that after every row, you knock out the old array because notoffsetnum goes back to 0, and then you redim the array back to a size of 1. That throws away everything and at the end you've just got the last row. I ASSUME that's an error. Since this is something that comes up a lot, here's something that I think is a bit cleaner, and a little less brittle. The only assumption I make is that you start in B2, and that you have data going both down and to the right. If that's ever going to be a problem you can alter it a bit. I just think you'll find the range.end(xl...) methods a lifesaver. It takes you the cell you'd get if you pressed ctrl+arrow key, so it's a fast way to tease out the edges of ranges.
Sub BetterSolution()
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Dim firstCell As Range
Set firstCell = ws.Range("B2")
Dim lastCol As Integer
lastCol = firstCell.End(xlToRight).Column
Dim lastRow As Integer
lastRow = firstCell.End(xlDown).Row
Dim lastCell As Range
Set lastCell = ws.Cells(lastRow, lastCol)
Dim arr() As Integer
Dim rng As Range
Dim index As Integer
index = 0
For Each rng In ws.Range(firstCell, lastCell).Cells
index = index + 1
ReDim Preserve arr(index + 1)
arr(index) = rng.Value
Next rng
End Sub
The problematic bit of my code was this:
Dim anotherarrayofnumbers() As Integer
This led to an error on:
anotherarrayofnumbers(notoffsetnum) = c.Value
This was because some of my c.Value values were not actually integers.
One way to solve this is changing the array to the Variant type:
Dim anotherarrayofnumbers() As Variant
But this did not work for me as I later had to perform integer operations (such as WorksheetFunction.Quartile) on the array. Instead I simply applied formatting to those c.Value values that were not integer values, so as to filter them out of my array. This resolved my issues.
So my conditional on the If block now looks like this:
If c.Interior.Color <> 192 And c.Interior.Color <> 177 And Not IsEmpty(c.Value) Then
Where the additional interior color is what I formatted the non-integer values as.
UPDATE:
Alright, so i used the following code and it does what i need it to do, i.e check if the value is 0 and if its is, then delete the entire row. However i want to do this to multiple worksheets inside one workbook, one at a time. What the following code is doing is that it removes the zeros only from the current spreadsheet which is active by default when you open excel through the VBA script. here the working zero removal code:
Dim wsDCCTabA As Excel.Worksheet
Dim wsTempGtoS As Excel.Worksheet
Set wsDCCTabA = wbDCC.Worksheets("Login")
Set wsTempGtoS = wbCalc.Worksheets("All_TemporaryDifferences")
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
What am i doing wrong? when i do the same thing for another worksheet inside the same workbook it doesnt do anything. I am using the following code to remove zeros from anohter worksheet:
Set wsPermGtoS = wbCalc.Worksheets("All_PermanentDifferences")
'delete rows with 0 description
Dim LastRow As Long, n As Long
LastRow = wsPermGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then
Cells(n, 5).EntireRow.Delete
End If
Next
Any thoughts? or another way of doing the same thing?
ORIGINAL QUESTION:
I want to delete all the rows which have a zero in a particular column. I am using the following code but nothing seems to happen:
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
End If
Next
StartRow contains the starting row value
CurrRow contains the row value of the last used row
See if this helps:
Sub DelSomeRows()
Dim colNo As Long: colNo = 5 ' hardcoded to look in col 5
Dim ws As Worksheet: Set ws = ActiveSheet ' on the active sheet
Dim rgCol As Range
Set rgCol = ws.Columns(colNo) ' full col range (huge)
Set rgCol = Application.Intersect(ws.UsedRange, rgCol) ' shrink to nec size
Dim rgZeroCells As Range ' range to hold all the "0" cells (union of disjoint cells)
Dim rgCell As Range ' single cell to iterate
For Each rgCell In rgCol.Cells
If Not IsError(rgCell) Then
If rgCell.Value = "0" Then
If rgZeroCells Is Nothing Then
Set rgZeroCells = rgCell ' found 1st one, assign
Else
Set rgZeroCells = Union(rgZeroCells, rgCell) ' found another, append
End If
End If
End If
Next rgCell
If Not rgZeroCells Is Nothing Then
rgZeroCells.EntireRow.Delete ' deletes all the target rows at once
End If
End Sub
Once you delete a row, u need to minus the "Count" variable
CurrRow = (Range("E65536").End(xlUp).Row)
For Count = StartRow To CurrRow
If wsDCCTabA.Range("E" & Count).Value = "0" Then
wsDCCTabA.Rows(Count).Delete
' Add this line:
Count = Count - 1
End If
Next
I got it. For future reference, i used
ActiveWorkbook.Sheets("All_temporaryDifferences").Activate
and
ActiveWorkbook.Sheets("All_Permanentdifferences").Activate
You don't need to use ActiveWorkbook.Sheets("All_temporaryDifferences").Activate. In fact if the ActiveWorkbook is different from wbCalc you would get an error.
Your real problem is that you are using an unqualified reference to Cells(n, 5).Value. Unqualified means that you aren't specifying which sheet to use so it defaults to the active sheet. That may work sometimes but it is poor code. In your case it didn't work.
Instead you should always use qualified references. wsTempGtoS.Cells(n, 5).Value is a qualified reference. wsTempGtoS specifies which worksheet you want so VBA is not left guessing.
Dim LastRow As Long, n As Long
LastRow = wsTempGtoS.Range("E65536").End(xlUp).Row
For n = LastRow To 1 Step -1
If wsTempGtoS.Cells(n, 5).Value = 0 Then
wsTempGtoS.Cells(n, 5).EntireRow.Delete
End If
Next
This: CurrRow = (Range("E65536").End(xlUp).Row) is also an unqualified reference. Instead it should be CurrRow = wsDCCTabA.Range("E65536").End(xlUp).Row.