I have a worksheet, that I need to move the row, if the value on the last column is equal to false.
I don't know how to move to sheet 2 and make go through entire sheet.
Thank for the help.
Sub DeleteMatches2()
Dim a As Range, b As Range
Dim c As String
'The column that has the value is V2
With Sheets("Controle Estoque Fixo")
Set a = .Range(.Cells(2, "V"), .Cells(Rows.Count, "V").End(xlUp))
End With
For Each b In a
If b.Value = "False" Then
Sheets("Sheet1").Select
'know I am lost
End If
Next
End Sub
There are many ways to do this, the simplest is to keep a row counter, which tracks how many rows you've used on on the other sheet. Increment this counter by one each time. Lets assume you have column headers on sheet1, so the first available row is row 2:
Sub DeleteMatches2()
Dim a As Range, b As Range
Dim c As String
Dim rowCounter As Long
rowCounter = 2 ' start at row 2
'The column that has the value is V2
With Sheets("Controle Estoque Fixo")
Set a = .Range(.Cells(2, "V"), .Cells(Rows.Count, "V").End(xlUp))
End With
For Each b In a
If b.Value = "False" Then
'Sheets("Sheet1").Select ' you don't need to select an object to access it, so remove this
'here's the bit you need
Sheets("Controle Estoque Fixo").Rows(b.row).Cut Sheets("Sheet1").Rows(rowCounter) ' this cuts and pastes all in one line
' you use the row counter to specify the destination
rowCounter = rowCounter + 1 ' the next time you'll paste on the next row
End If
Next
End Sub
As people have commented there are many many many ways to do this so have a good look on Stack Overflow, something else might appeal to you.
Related
This sounds like a very basic question (and it is), but I cannot figure it out and I cannot find a suitable solution on the web.
How do you select the last cell in a column that contains a numeric value and delete it?
I have formulas that go past this cell and return blank values in the column. This is what is tripping me up at the moment. My current code will go all the way down to where I have carried the formulas to and start deleting those cells instead of deleting the last cell with a numeric value.
My current code looks like this
Range("AA1500").End(xlUp).Select
With Selection.Delete
End With
Any help would be greatly appreciated.
Please let me know if I can clarify anything.
Thanks
If you want to go down past cells with arbitrary strings in them and
delete the last numeric value (but not the last cell with a alphanumeric string in it), this should work:
Sub deleteLastNum()
Dim row As Integer
row = Range("A1000").End(xlUp).row
For i = row To 1 Step -1:
If IsNumeric(Cells(i, "A")) Then
Cells(i, "A").Clear
Range("A" & CStr(i + 1), "A" & CStr(row)).Cut Destination:=Range("A" & CStr(i))
Exit For
End If
Next
End Sub
It will also delete the last cell with a formula that evaluates to a number. It moves down the range of cells in the column above it with characters in it to fill in the cleared cell.
What you can do is get the total number of rows of a column (A) then check is last cell value is numeric or not, if numeric then clear that cell.
Sub del()
Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(Sheets("Sheet1").Range("A" & k).Value) = True Then
Sheets("Sheet1").Range("A" & k).ClearContents
End If
End Sub
This will check last cell for numeric value in column A.
Hope this is what you are asking.
EDIT
Implementing above for all the sheets in a workbook using a loop is like :
Sub del()
Dim sh As Worksheet
Dim rn As Range
For Each sh In ActiveWorkbook.Worksheets
Set sh = ThisWorkbook.Sheets(sh.Name)
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(sh.Range("A" & k).Value) = True Then
sh.Range("A" & k).ClearContents
End If
Next sh
End Sub
This will loop through each sheet like Sheet1, Sheet2 or whatever the name of the sheet may be and check for numeric value in last cell of col A, if found numeric then it will delete the value.
You already got an answer to your post, just to be clear, the safest way to find the last row (let's say in Column "AA", according to your post), and ignoring blank cells in the middle, is by using the syntax below:
Sub FindlastRow()
Dim LastRow As Long
With Worksheets("Sheet1") ' <-- change "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "AA").End(xlUp).Row
' rest of your coding here
End With
End Sub
Screen-shot of the result:
Use 'SpecialCells()'
Sub ClearLastNumber(sh As WorkSheet, columnIndex As String)
On Error GoTo ExitSub 'should 'columnIndex' column of 'sh' worksheet contain no numbers then the subsequent statement would throw an error
With sh.Columns(columnIndex).SpecialCells(xlCellTypeConstants, xlNumbers)
With .Areas(.Areas.Count)
.Cells(.Count).ClearContents
End With
End With
ExitSub:
End Sub
To be used in your "main" sub as follows
Sub Main()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
ClearLastNumber Sh "A"
Next
End Sub
I've been working on this for longer than I'd like to admit. I'm comparing two Worksheets (A & B). I'm looping through A-Column("B") and for each value in that column I'm checking it against B-Column("C"). If there's a match, I want to delete the entire row.
I've done it a number of different ways and I just can't get it to work. This is the original:
Option Explicit
Sub Purge()
Dim wipWS As Worksheet
Dim invWS As Worksheet
Dim C As Range
Dim SourceLastRow As Long
Dim DestLastRow As Long
Dim LRow As Long
Dim D As Range
Set wipWS = Worksheets("Work in Process")
Set invWS = Worksheets("Inventory Allocation")
With wipWS
' find last row in Work in Process Column B
SourceLastRow = .Cells(.Rows.count, "E").End(xlUp).Row
' find last row in Inventory Allocation Column C
DestLastRow = invWS.Cells(invWS.Rows.count, "B").End(xlUp).Row
' define the searched range in "Inventory Allocation" sheet
Set C = invWS.Range("B1:B" & DestLastRow)
Set D = wipWS.Range("E1:E" & SourceLastRow)
' allways loop backwards when deleting rows or columns
' choose 1 of the 2 For loops below, according to where you want to delete
' the matching records
' --- according to PO request delete the row in Column B Sheet A
' and the row in Column C in "Inventory Allocation" worksheet
' I am looping until row 3 looking at the PO original code
For LRow = SourceLastRow To 1 Step -1
' found a match between Column B and Column C
If Not IsError(Application.Match(.Cells(LRow, "E"), C, 0)) Then
.Cells(LRow, 2).EntireRow.Delete Shift:=xlUp
invWS.Cells(Application.Match(.Cells(LRow, "E"), C, 0), 2).EntireRow.Delete Shift:=xlUp
End If
Next LRow
End With
End Sub
It works, except it leaves 1 row left (that should be deleted). I think I know why it's happening, except I have no idea of how to do it. I've tried a For loop and it works, except I have to set a range (eg., "A1:A200") and I want it to only loop through based on the number of rows.
Any help would be greatly appreciated!
Instead of running 2 loops, you can run 1 For loop in yout Worksheets("Work in Process"), scanning Column B, and then just use the Match function to search for that value in the entire C range - which is Set to Worksheets("Inventory Allocation") at Column C (untill last row that has data).
Note: when deleting rows, allways use a backward loop (For loop counting backwards).
Code
Option Explicit
Sub Purge()
Dim wipWS As Worksheet
Dim invWS As Worksheet
Dim C As Range
Dim SourceLastRow As Long
Dim DestLastRow As Long
Dim LRow As Long
Set wipWS = Worksheets("Work in Process")
Set invWS = Worksheets("Inventory Allocation")
With wipWS
' find last row in Sheet A Column B
SourceLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' find last row in Sheet B Column C
DestLastRow = invWS.Cells(invWS.Rows.Count, "C").End(xlUp).Row
' define the searched range in "Inventory Allocation" sheet
Set C = invWS.Range("C1:C" & DestLastRow)
' allways loop backwards when deleting rows or columns
' choose 1 of the 2 For loops below, according to where you want to delete
' the matching records
' --- according to PO request delete the row in Column B Sheet A
' and the row in Column C in "Inventory Allocation" worksheet
' I am looping until row 3 looking at the PO original code
For LRow = SourceLastRow To 3 Step -1
' found a match between Column B and Column C
If Not IsError(Application.Match(.Cells(LRow, "B"), C, 0)) Then
.Cells(LRow, 2).EntireRow.Delete Shift:=xlUp
invWS.Cells(Application.Match(.Cells(LRow, "B"), C, 0), 3).EntireRow.Delete Shift:=xlUp
End If
Next LRow
End With
End Sub
You are comparing two Worksheets (A & B). You want to loop through A-Column("B") and for each value in that column, check against B-Column("C").
So you can have a counter (ie. bRow) to keep track of which row you are looking at in worksheet B
Dim cell as Range
Dim bRow as Integer
bRow = 1
With Worksheets("A")
For Each cell in Range(.Range("B1"), .Range("B1").End(xlDown))
If (cell.Value = Worksheets("B").Range("C" & bRow).Value0 Then
cell.EntireRow.Delete Shift:=xlUp
Worksheets("B").Range("C" & bRow).EntireRow.Delete Shift:=xlUp
Else
bRow = bRow + 1
End If
Next cell
End WIth
So I finally figured this out. It's not pretty and I'm sure there is a more elegant way of doing this, but here it is.
Option Explicit
Public Sub purWIP()
Dim wipWS As Worksheet
Dim invWS As Worksheet
Dim P As Range
Dim i As Integer, x As Integer
Set wipWS = Worksheets("Work in Process")
Set invWS = Worksheets("Inventory Allocation")
' Start by checking conditions of a certain row
For x = wipWS.UsedRange.Rows.count To 1 Step -1
With wipWS
' For each cell in wipWS I'm going to check whether a certain condition exists
For Each P In wipWS.Range(.Cells(6, 5), .Cells(wipWS.Rows.count, 5).End(xlUp))
'If it does, then I'm going to check the Inventory Allocation Worksheet to see if there's a match
If (IsDate(P.Offset(0, 7))) Then
invWS.Activate
' I do a for loop here and add 1 to i (this was the part that fixed it)
For i = invWS.UsedRange.Rows.count + 1 To 3 Step -1
If invWS.Cells(i, "B") = P.Offset(0, 0) Then
invWS.Rows(i).EntireRow.Delete Shift:=xlUp
End If
Next
P.EntireRow.Delete Shift:=xlUp
End If
Next
End With
Next
wipWS.Activate
End Sub
I am trying to piece together code to make my macro work correctly. This approach has served me well in the past but I cannot seem to adapt any code correctly.
I found the following
Sub way()
Dim Cell As Range
For Each Cell In Range("A1").CurrentRegion
If Len(Cell) < 2 Then Cell.EntireRow.Delete
Next Cell
End Sub
I can adapt the If Len(Cell) criteria to my liking. For example = 10
I do not know how to adapt the code to make it search through all cells in column A and delete the appropriate rows. The code above only does it for A1.
Ideally I would like to delete all rows with cells in column A that have a length of 10 characters. Or alternatively, with a completely different set of code, delete all other rows that do not contain cells in column A that have a length of 10 characters.
When deleting rows it is best to loop backwards:
Sub way()
Dim ws As Worksheet
Dim i As Long
Dim lastrow As Long
Set ws = ActiveSheet
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For i = lastrow To 1 Step -1
If Len(ws.Cells(i, 1)) < 2 Then ws.Rows(i).Delete
Next i
End Sub
Essentially, your loop is going through every cell in the Range.CurrentRegion property radiating out from A1. Your narrative expresses that you only want to examine column A but delete the Range.EntireRow property.
The For .. Next loop stepping backwards proposed by Scott Craner is likely your best bet but if you are more comfortable with a For ... Each In loop then yours can be adjusted.
Sub way()
Dim cl As Range, dels As Range
With Worksheets("Sheet1")
For Each cl In .Range("A1").CurrentRegion.Columns(1).Cells
If Len(cl.Value2) = 10 Then
If Not dels Is Nothing Then
Set dels = Union(dels, cl)
Else
Set dels = cl
End If
End If
Next cl
End With
If Not dels Is Nothing Then _
dels.EntireRow.Delete
End Sub
The logic to delete rows that did not have a value in column A that was 10 characters, symbols or digits long would be If Len(cl.Value2) <> 10 Then.
I haven't checked for syntax, but something like this should work:
dim idx as integer
idx = 1
while Range("A" + cstr(idx)).value <> ""
'insert your delete logic here...
idx = idx + 1
wend
I have a VBA Excel code with that checks values in a specific column. If the row in that column contains the value 'Delete' and then deletes the row.
The code works well, but it is really slow. Any ideas on how to get the code run faster?
Dim rng1 As Range
Dim i As Integer, counter As Integer
'Set the range to evaluate to rng.
Set rng1 = Range("g1:g1000")
'initialize i to 1
i = 1
'Loop for a count of 1 to the number of rows
'in the range that you want to evaluate.
For counter = 1 To rng1.Rows.Count
'If cell i in the range1 contains an "Delete"
'delete the row.
'Else increment i
If rng1.Cells(i) = "Delete" Then
rng1.Cells(i).EntireRow.Delete
Else
i = i + 1
End If
Next
Thanks
c.
Sub deletingroutine()
Dim r As Range
For Each r In Range("g1:g1000")
If r = "delete" Then r.EntireRow.Delete
Next r
End Sub
I managed to find a solution with the Autofilter function.
Hope it helps someone
Selection.AutoFilter
Set ws = ActiveWorkbook.Sheets("UploadSummary")
lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("G1:G" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=7, Criteria1:="delete" ' 7 refers to the 7th column
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Try sorting the rows (on collumn G) then deleting all marked ("delete") rows in one action. That is much faster.
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub