I have a problem with my code about delete blank rows. It just has to delete some rows not all blank rows and rows value "0". I don't wanna use .SpecialCells(xlCellTypeBlanks) as some threat on SO forum.
Dim R As Integer
R = Range("CuoiNKC").Row - 1
Dim DelCell As Range
Dim DelRange As Range
Set DelRange = Range("J9:J" & R)
For Each DelCell In DelRange
If DelCell.Value = "0" Or DelCell.Formula = Space(0) Then
DelCell.EntireRow.Delete
End If
Next DelCel
Why don't you use Range AutoFilter Method instead of looping.
Assuming you have the correct value of DelRange in your code, try this:
DelRange.AutoFilter 1, AutoFilter 1, "=0", xlOr, "=" 'filtering 0 and space
DelRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp 'delete visible cells
ActiveSheet.AutoFilterMode = False 'remove auto filter mode
Btw, if you want to stick with your logic, you need to iterate the rows backward.
You can only do that using the conventional For Next Loop. Again assuming value of R is correct.
For i = R To 9 Step -1
If Range("J" & i).Value = "0" Or Range("J" & i).Value = " " Then
Range("J" & i).EntireRow.Delete xlUp
End If
Next
Related
I am trying to delete a specific range based on whether or not column "C" meets specific criteria.
Currently I have the following:
If Range("C69") = "All values USD Millions." Then
Range("C69 : H69").Delete shift:=xlUp
Else Range("A3").Select
End If
I want to turn this into a loop that will search cells "C1" through "C100" for the words "All values USD Millions." and delete the corresponding C though H range. For example, if it found the value in "C15", it would delete Range("C15:H15").
Unfortunately, I am still learning and all the loops I try create an error.
You can use the filtering capability of Excel:
With Sheet1.Range("C1:H100")
.AutoFilter 1, "All values USD Millions."
.Offset(1).Delete
.AutoFilter
End With
However if you want to do a "classic" iteration and delete while iterating on the rows, remember always that in these cases you should iterate "backward":
Dim i as long
For i = Range("C999999").End(xlUp).Row to 1 Step -1
If Cells(i, "C").Value2 = "All values USD Millions." Then Rows(i).Delete
Next
Another fast way, without looping throughout the rows one by one, is using the Find function:
Option Explicit
Sub UseFindFunc()
Dim FindRng As Range
Dim Rng As Range
Dim LastRow As Long
Dim TexttoFind As String
TexttoFind = "All values USD Millions." ' <-- try to use variable, easy to modify later
With Sheet1
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row '<-- get last row with data in Column C
Set Rng = .Range("C1:H" & LastRow)
Set FindRng = Rng.Find(What:=TexttoFind, LookIn:=xlValues, LookAt:=xlWhole)
While Not FindRng Is Nothing '<-- find was successful
FindRng.Resize(, 5).Delete xlShiftUp '<-- delete column "C:H" in found row
Set FindRng = Rng.Find(What:=TexttoFind, LookIn:=xlValues, LookAt:=xlWhole)
Wend
End With
End Sub
If you don't want to delete cells from columns A and B, this works for me:
Sub test()
Dim i As Integer
For i = 1 To 100
If Range("C" & i) = "All values USD Millions." Then
Range("C" & i & ":H" & i).Delete
Else
Range("A3").Select
End If
Next
End Sub
If your data is not as static you could do the script till your last row or set i = 1 to 100 to stop at row 100
Sub test()
Dim lRow As Long
lRow = WorksheetFunction.Max(Range("C65536").End(xlUp).Row,
Range("D65536").End(xlUp).Row, Range("E65536").End(xlUp).Row)
With ActiveSheet
For i = lRow To 2 Step -1
If .Cells(i, "C").Value = "All values USD Millions." Then
Range("C" & i & ":H" & i).ClearContents
End If
Next i
End With
End Sub
Try using:
For i=1 to 100
If Cells (i, 3) = "All values USD Millions." Then
Rows (i).Delete
EndIf
Next
Hi I'm a bit new to vba so I will try to explain my problem as far as possible.
I have a dataset in Excel in Column A, I have a lot of file names like this:
1. AB000**1234**45.tif
2. AB000**1235**45.tif
3. AB000**1236**45.tif
4. AB000**1237**45.tif
etc..
From this I want to take out all the strong characters and put in column C so it will look like this:
1. 1234
2. 1235
3. 1236
4. 1237
etc..
At the moment I have a code that looks like this:
Sub TakeOut
Dim str1 As String
Dim LR As Long
Dim cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
For Each cell In RNG
L = Len(RNG)
If L > 0 Then
RNG = ...
End If
Next cell
Range("C:C").Columns.AutoFit
End Sub
I have tried to count left(5) and right(6) but don't know how to take out the 4 character that I want.
Hope you can help me with this.
If you want to take out the strong characters from the string. Try it below. It will take all the Bold Characters in a cell and place it in C column.
Hope you are looking for this?
Sub get_bold_content()
Dim lastrow, i, j, totlength As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
totlength = Len(Range("A" & i).Value)
For j = 1 To totlength
If Range("A" & i).Characters(j, 1).Font.Bold = True Then
outtext = outtext & Range("A" & i).Characters(j, 1).Text
End If
Next j
Range("C" & i).Value = outtext
outtext = ""
Next i
End Sub
Take a look at the Mid() Function link.
usage in your case:
Mid(cell.Value, 6, 4) 'First parameter is the string, 6 is the start character, 4 is length
The easiest way without looping would be something like this:
Sub TakeOut()
Dim rng As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rng.Offset(, 1) = Evaluate("IF(" & rng.Address & "="""","""",MID(" & rng.Address & ",6,4))")
End Sub
I want to make a macro that clears the content of the cells in the blue border (~40.000 Rows) when the cells in the red border (column AX) contain the text "NoBO" (=No Backorder) without losing the formulas in the columns AP:AX.
Sub clear_ranges()
Dim ws As Worksheet
Dim x As Integer
Dim clearRng As Range
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Input")
For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
If (ws.Range("AX6" & x).Value = "NoBO") Then
If clearRng Is Nothing Then
Set clearRng = ws.Range("B6" & x & ":" & "AN6" & x)
Else
Set clearRng = Application.Union(clearRng, ws.Range("B6" & x & ":" & "AN6" & x))
End If
End If
Next x
clearRng.Clear
End Sub
And for some reason:
For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
gives me a error "Overflow". After searching I know what this error means but I can't find a solution for this.
tl;dr - I want to delete the range B6:B##### (till last row) to AN6:AN####*(till last row) if cell AX##### containts NoBO
It is too easy to get an overflow using Integer. Replace:
Dim x As Integer
with:
Dim x As Long
Try:
Sub clear_ranges()
Dim ws As Worksheet
Dim x As Integer
Dim clearRng As Range
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Input")
For x = 6 To ws.Range("B" & Rows.Count).End(xlUp).Row
If ws.Range("AX" & x).Value = "NoBO" Then
ws.Range("B" & x & ":" & "AN" & x).Clear
End If
Next x
Application.ScreenUpdating = True
End Sub
I think the Union function can only store up to 30 ranges so it might not suit your needs.
Hi if you are Deleting Rows it's the Best to use a For Each Loop or start from the bottom of the column and work up.
'Loop through cells A6:Axxx and delete cells that contain an "x."
For Each c In Range("AX6:A" & ws.Range("B" & Rows.Count).End(xlUp).Row)
If c.Value2 = "NoBo" Then
Set clearRng = ws.Range("B" & c.Row & ":" & "AN" & c.Row)
End If
clearRng.Clear
Next
try this
Option Explicit
Sub clear_ranges()
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Input")
With ws
With .Range("B5:AX" & .Cells(.Rows.Count, "B").End(xlUp).Row) 'take all data
.AutoFilter Field:=49, Criteria1:="NoBO" 'filter to keep only rows with "NoBO" in column "AX" (which is the 49th column from column "B"
With .Offset(1).Resize(.Rows.Count - 1) 'offset from headers
If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 0 Then Intersect(.SpecialCells(xlCellTypeVisible), ws.Columns("B:AN")).ClearContents 'clear cells in columns "B:AN" of filtered rows
End With
.AutoFilter 'remove autofilter
End With
End With
Application.ScreenUpdating = True
End Sub
You can try
Assuming that there are no blank cells in AX Column
Sub clr_cell()
For i = 6 To ActiveSheet.Range("AX6", ActiveSheet.Range("AX6").End(xlDown)).Rows.Count
'counts the no. of rows in AX and loops through all
If ActiveSheet.Cells(i, 50).Value = "NoBo" Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 40)).ClearContents
'clears range B to AN
End If
Next i
End Sub
I tested this on 40k rows and it worked fine. It takes a while to execute due to the no. of rows maybe.
I was wondering if someone would be kind enough to suggest some corrections to the indicated line in the script below.
It is throwing up "Object variable or With block variable not set" alarm.
I can only guess this means the "CellFound" range is not being set and that the problem lies within that line.
The "CellFound" variable is meant to find and store the location of a cell.value<=25 within DateRng for use by the following condition
To re-iterate, the entire script is to carry out the following tasks:
Locate a range that is located between 2 cells containing specific strings (DateRng)
Loop within this range for cells (i) that have a value <=25
Compare two other cells which are offset to "i"
Export a range of rows centered around "i" to different sheets pending the outcome of the above condition.
Thanks for your time.
Sub ReportCells()
Dim LR As Long, i As Long
Dim j, k As Long
Dim StartDate, FinishDate As String
Dim Sh As Worksheet: Set Sh = Sheets("Full chart and primary cals")
Dim CellFound As Range
'Range Extraction Script
'Search location and values
LookupColumn = "B"
StartDate = "2013.01.02 20:00"
FinishDate = "2013.01.09 20:00"
'Find Lower Limit
For j = 1 To 30000
If Sh.Range(LookupColumn & j).Value = FinishDate Then FinishDateRow = j
Next j
'Find Upper Limit
For k = FinishDateRow To 1 Step -1
If Sh.Range(LookupColumn & k).Value = StartDate Then StartDateRow = k - 1
Next k
'Set Range once located
Dim DateRng As Range: Set DateRng = Sh.Range(LookupColumn & StartDateRow & ":" & LookupColumn & FinishDateRow)
MsgBox DateRng.Address
'Find Cell
With DateRng
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LR
** Set CellFound = .Find(Sh.Range("M:M").Value <= 25, LookIn:=xlValues) **
MsgBox CellFound.Address
If Not CellFound Is Nothing And CellFound.Offset(0, -5).Value < CellFound.Offset(-1, -5).Value Then .Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("DownT").Range("A" & Rows.Count).End(xlUp).Offset(2)
If Not CellFound Is Nothing And CellFound.Offset(0, -5).Value > CellFound.Offset(-1, -5).Value Then .Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("UpT").Range("A" & Rows.Count).End(xlUp).Offset(2)
Next i
End With
End Sub
EDIT: The cell selection and copy block has been modified to the code below. It seems that the value<=25 set range commands are not executing as they should be. They are definately filtering data but on what column I am not sure. The block is returning a range of cells of the correct size. But only one range (instead of around 20 or so). And of the wrong range of rows :S I guess any progress is progress regardless of if it's right or wrong
With Sheets("Full chart and primary cals")
LR = Range("B" & Rows.Count).End(xlUp).Row
'For i = Range("M" & Rows.Count).End(xlUp).Row To 1 Step -1
For i = 1 To LR
With DateRng.Range("M" & i)
If Range("M" & i).Value <= 25 Then Set CellFound = Sh.Range("M" & i)
If Not CellFound Is Nothing Then .Offset(-5, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("DownT").Range("A" & Rows.Count).End(xlUp).Offset(2)
End With
Next i
End With
The solution to the problem........
'Loop through sheet looking for cells
LR = .Range("B" & Rows.Count).End(xlUp).Row
For i = 10 To LR
'Find cells in "M" and store thier reference in Cellref
If .Range("M" & i).Value <= 25 Then Set Cellref = .Range("M" & i) Else Set Cellref = .Range("Z15")
'Find if Cell ref is contained within DateRange and store result as bool
If Not Application.Intersect(DateRange, Cellref) Is Nothing Then iSect = True Else iSect = False
'Output cell ranges to the appropriate sheets
If iSect = True And Cellref.Offset(0, -5) < Cellref.Offset(-10, -5) Then _
Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("DownT").Range("A" & Rows.Count).End(xlUp).Offset(2)
If iSect = True And Cellref.Offset(0, -5) > Cellref.Offset(-10, -5) Then _
Cellref.Offset(-3, 0).Resize(10, 1).EntireRow.Copy Destination:=Sheets("UpT").Range("A" & Rows.Count).End(xlUp).Offset(2)
Next i
From what I can tell from your code you're misusing the Range.Find() function, which will most probably cause it to return Nothing instead of a meaningful range.
Sh.Range("M:M").Value will throw a Type Mismatch error as you cannot use the .Value property of a Range containing multiple cells. As this error is contained within the arguments of your .Find function it's entirely possibly it's just being ignored but it will still cause .Find to return Nothing.
Even were that not the case Sh.Range("A1") <= 25 evaluates to either True or False (Depending on the value of A1) and the Find function would then search DateRng for the first instance of True or False within that range.
I'd recommend some further reading on how the Range.Find function works as it may not be suitable for the task you have in mind.
Can someone tell me what VB code I can use, to obtain the following macro excel result?
I want for content from column A to be deleted if column B is blank. This is how far I have come:
If Range ("B66")= IsEmpty Then
Range ("A66").Select
Selection.ClearContents
End If
Sub Main()
Application.ScreenUpdating = False
Dim i As Long, r As Range
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
Set r = Range("A" & i)
If IsEmpty(r.Offset(0, 1)) Then r.EntireRow.Delete shift:=xlUp
Next i
Application.ScreenUpdating = True
End Sub
first you need a loop to cycle through all cells in column A
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 sets up a loop that iterates from the last cell to the first one in column A
Range("A" & Rows.Count).End(xlUp).Row finds the last cell used in column A
Set r = Range("A" & i) sets r variable to be a Range object
If IsEmpty(r.Offset(0, 1)) Then Offset points to cell in column B on the same row, so if it the neighbouring cell of column A (which is cell(sameRow, column B) is empty then
r.EntireRow.Delete shift:=xlUp delete entire row
Application.ScreenUpdating = False/True turn off screen updating to speed up the execution when using loops