If anyone is willing to help me, I'd be most grateful.
Basically I would like to perform the same task as what was featured in this thread...
Excel Marcro - delete a row based on row number
I have a list of 3500+ lines and need to occasionally delete about 25-30 (non-consecutive) rows based on row number (the row #s will vary every time). I'd like to list the row numbers (to be deleted) on Sheet2 (in Column A) and have the code automatically read the row numbers on Sheet2 and delete those rows from Sheet1. I tried the code provided in the thread and I get a "run-time error 424" Object required. If I mouse over the error it tells me "SourceWks = Nothing" and "Sheet2 = Empty". I do have data contained in the sheet(s). I'm sure I'm just missing something simple.
I'll paste the code I'm using below (again it is from the original thread which was reported by the user to work just fine)...
Dim deleteRows As Range
Dim data() As Variant
Dim i As Double
Dim SourceWks As Worksheet, deleteWks As Worksheet
Set SourceWks = Sheet2
Set deleteWks = Sheet1
With SourceWks
data = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
Set deleteRows = deleteWks.Rows(data(1, 1))
For i = 2 To UBound(data, 1)
Set deleteRows = Union(deleteRows, deleteWks.Rows(data(i, 1)))
Next i
deleteRows.Delete Shift:=xlUp
I've tried it both ways...keeping Sheet1 named "Sheet1" and Sheet2 named "Sheet2" and I've also tried changing the sheets to be named to: "deleteWKS" and "SourceWks" all with the same results.
If anyone can please let me know what I'm doing incorrectly, I'd be most appreciative.
Consider:
Sub rowKiller()
Dim SourceWks As Worksheet, deleteWks As Worksheet
Dim rng As Range, i As Long
Set SourceWks = Sheet2
Set deleteWks = Sheet1
Set rng = SourceWks.Columns(1).SpecialCells(2)
rng.Sort Key1:=rng(1), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For Each r In rng
i = r.Value
deleteWks.Rows(i).EntireRow.Delete
Next r
End Sub
NOTES:
The reason we sort the row list descending because we want to delete the rows in Sheet1 from the bottom upwards.
Related
I am still quite new to VBA and decided I would try and teach myself the Range.FindNext method. Unfortunately, I am not very successful so far.
What I am trying to do, is to copy all rows with a specific search term in them to a new sheet (could be anything, therefore declared as a Variant). What is important, is that the search term might only be part of the cell's value, hence I am using xlPart in my Range.Find method.
Here the example data from my ActiveWorkbook.ActiveSheet:
Date Name Numbers
12.04.2012 Marla 45653
13.04.2017 Peter 23545
27.04.1985 Bertrud 46932
16.08.2020 Peterson 46764
15.09.2014 Marcos 32465
21.06.2010 Peter Pan 23452
31.08.2013 Bernard 12321
So, when looking for "Peter", I should be getting rows 3, 5 and 7 in a new sheet. This is the code I wrote for this:
Option Explicit
Dim wsMain, wsNew As Worksheet
Dim rgAll, rgSearchTermFind As Range
Dim varSearchTerm As Variant
Dim lngLastRow, lngLastColumn As Long
Dim firstAddress As String
Public Sub FindAndCopy()
'I have an InputBox for the user to determine the varSearchTerm, but for this example:
varSearchTerm = "Peter"
Set wsMain = ActiveWorkbook.ActiveSheet
Set wsNew = Sheets.Add(After:=Worksheets(Sheets.Count))
Call FindLast(wsMain) 'This is a separate sub I wrote to find the last row & column
With wsMain
Set rgAll = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastColumn))
End With
With rgAll
Set rgSearchTermFind = .Find(What:=varSearchTerm, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlNext, _
MatchCase:=False)
If Not rgSearchTermFind Is Nothing Then
firstAddress = rgSearchTermFind.Address
Do
'Copy row to new sheet
If Application.WorksheetFunction.CountA(wsNew.Cells) <> 0 Then
Call FindLast(wsNew) 'This is a separate sub I wrote to find the last row & column
wsMain.Range(rgSearchTermFind.Address).EntireRow.Copy _
Destination:=wsNew.Cells(lngLastRow + 1, 1)
Else
wsMain.Range(rgSearchTermFind.Address).EntireRow.Copy _
Destination:=wsNew.Cells(1, 1)
End If
'Find next occurrence of search term
Set rgSearchTermFind = .FindNext(rgSearchTermFind)
Loop Until rgSearchTermFind.Address = firstAddress
Else
'Code here to execute if search term could not be found
End If
End With
End Sub
When running this code, the initial Range.Find method finds Peter in B3, but the Range.FindNext then finds "Bertrud" in B4 and copies it. This happens for each cell in the range, leaving me at the end with the table copied three times in the new sheet (due to there being three columns).
What am I doing wrong? Any help will be much appreciated.
I have an Excel workbook with 250,000 rows and 10 columns and I want to split up the data into different workbooks. My idea was to filter the list so that Excel/VBA doesn't have to go through all 250,000 rows every time my code says to look for something in the data.
However, I've run into one specific problem with Sort and also have a general question regarding hidden rows and SpecialCells(xlCellTypeVisible). First off, here's the code:
Option Explicit
Sub Filtering()
Dim wsData As Worksheet
Dim cell As Variant
Dim lRowData As Long, lColData As Long
'filter
Set wsData = ThisWorkbook.Sheets(1)
lRowData = wsData.Cells(Rows.Count, 1).End(xlUp).Row
wsData.Range("A:A").AutoFilter Field:=1, Criteria1:="Name1"
For Each cell In wsData.Range(wsData.Cells(2, 1), wsData.Cells(100, 1)).SpecialCells(xlCellTypeVisible)
Debug.Print cell.Value
Next cell
'sort
lColData = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes ' returns error because of SpecialCells
End Sub
"Run-time error '1004': This can't be done on a multiple range selection. Select a single range and try again." This occurs in the last line, in
wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes. It only happens when I use SpecialCells(xlCellTypeVisible), so wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes works.
My thinking in using SpecialCells(xlCellTypeVisible) was that only then VBA would skip the filtered cells. I've tried it out, though, and to me it seems .Sort skips them anyway, with or without SpecialCells(xlCellTypeVisible) - can someone confirm this?
And this leads to my more general question: One thing I'm not quite clear on is when does Excel/VBA skip filtered rows and when it doesn't. To loop through the visible cells, I need to use SpecialCells(xlCellTypeVisible). With .Sort I (maybe) don't? And this question will always pop up for any operation I'll do on these filtered lists.
This made me wonder: should I work with my original sheet where part of the data is hidden or should I temporarily create a new sheet, copy only the data I need (= excluding the rows I've hidden with the filter) and then work with that? Would this new sheet make it quicker or easier in any way? What is better in your experience?
Your first error occurs when you attempt to copy nonadjacent cell or range selections e.g multiple nonadjacent rows within the same column (A1, A3, A5). This is because Excel "slides" the ranges together and pastes them as a single rectangle. Your visible special cells are nonadjacent, and therefore can't be copied as a single range.
It seems that excel is looping through all of the cells in your range, not just the visible ones. Your debug.print is returning more rows than just those that are visible.
I would take a different approach to tackling your problem by using arrays, which VBA is able to loop through extremely quickly compared to worksheets.
Using this approach, I was able to copy 9k rows with 10 columns based on the value of the first column from a sample size of 190k in 4.55 seconds:
EDIT: I did some messing around with the arrays which brought the time down to 0.45 seconds to copy 9k rows based on the first column from an initial 190k using the following:
Option Explicit
Sub update_column()
Dim lr1 As Long, lr2 As Long, i As Long, j As Long, count As Long, oc_count As Long
Dim arr As Variant, out_arr As Variant
Dim start_time As Double, seconds_elapsed As Double
Dim find_string As String
start_time = Timer
' change accordingly
find_string = "looking_for"
With Sheets("Sheet1")
' your target column in which you're trying to find your string
lr1 = .Cells(Rows.count, "A").End(xlUp).Row
lr2 = 1
' all of your data - change accordingly
arr = .Range("A1:J" & lr1)
' get number of features matching criteria to determine array size
oc_count = 0
For i = 1 To UBound(arr, 1)
If arr(i, 1) = find_string Then
oc_count = oc_count + 1
End If
Next
' redim array
ReDim out_arr(oc_count, 9)
' write all occurrences to new array
count = 0
For i = 1 To UBound(arr, 1)
If arr(i, 1) = find_string Then
For j = 1 To 10:
out_arr(count, j - 1) = arr(i, j)
Next j
count = count + 1
End If
Next
' write array to your target sheet, change sheet name and range accordingly
Sheets("Sheet2").Range("A1:J" & (oc_count + 1)) = out_arr
End With
seconds_elapsed = Round(Timer - start_time, 2)
Debug.Print (seconds_elapsed)
End Sub
It isn't super clean and could probably do with some refining, but if speed is important (which it often seems to be), this should do the job well for you.
As per bm13563 comment you are copying nonadjacent cells.
Also using a Sort will be altering your base data which could have an impact if you ever need to determine how it was initially ordered in the future.
Working with filters can become quite complex so a simpler (and not particularly slow) method could be to do a string search with your filtering value in your chosen column and then loop through the instances returned performing actions on each result.
The (slightly adapted) code below from David Zemens would be a good starting point (copied from Find All Instances in Excel Column)
Sub foo()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Set huntRange = Range("A:B")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:="January", after:=LastCell, LookIn:=xlValues)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Do
'Do your actions here, you can get the address of the found cell to return row etc.
MsgBox (FoundCell.Value)
Set FoundCell = myRange.FindNext(FoundCell)
Loop While (FoundCell.Address <> FirstFound)
End If
Set rng = FoundCell '<~~ Careful, as this is only the LAST instance of FoundCell.
End Sub
I really need help in VBA coding as I totally have no background in excel VBA. I did read up some basic coding but I think for the task I wanted to perform, it is far complicated for me. Basically, I wanted to copy many different columns with the headers from the original sheet to the new sheet whereby I can't copy the entire column because at a certain row below there exists some text information that I don't need. Also, the number of rows that contains data information I needed change for different excel file but I would like the code to be working for all files. Is this possible?
I attached a sample of what the data file will look like along
So I wanted columns with the shipment, vehicles, and delivery
PS. Actual file consists of many row and column and many unwanted data
Sub Sample()
Dim ws As Worksheet
Dim aCell As Range, Rng As Range
Dim col As Long, lRow As Long
Dim colName As String
'~~> Change this to the relevant sheet
Set ws = ActiveWorkbook.Sheets("Sheet 1")
With ws
Set aCell = .Range("A1:AZ30").Find(What:="Shipment", LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)
'~~> If Found
If Not aCell Is Nothing Then
'~~> Copy the entire column >> **how to change this??? I don't want the part e.g. id number to come with values under shipment**
aCell.EntireColumn.Copy
You could try:
Option Explicit
Sub test()
Dim strSearch As String
Dim strFound As Range
Dim LastRow As Long
'Assign to strSearch what we are looking for
strSearch = "Test"
'Refer to the sheet where data are
With ThisWorkbook.Worksheets("Sheet1")
'You could used ".UsedRange" to cover all used range of Sheet1
Set strFound = .UsedRange.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole)
'If we have results
If Not strFound Is Nothing Then
'Find the LastRow of the column where the finding is
LastRow = .Cells(.Rows.Count, strFound.Column).End(xlUp).Row
.Range(.Cells(strFound.Row + 1, strFound.Column), .Cells(LastRow, strFound.Column)).Copy
Else
MsgBox "No match"
End If
End With
End Sub
You're going to have to do some loops to make this work. So here is how I would do this for shipment and you can repeat the if statements for your other columns:
z = 12 'ending row
n = 12 'ending column K
y = 1 'starting column
Do While y <= n
x = 1 'starting row
Do While x <= z
If Cells(x, y) = "Shipment" Then
'Grab that cell's data, perhaps by saying Sheets("OtherSheet").Range("A1") = cells(x,y) or wherever you are looking to put this data. Insert perhaps another Do loop here to iterate x down until the data reaches an end or until z so that you can grab all the data under "Shipment".
Else
End If
x = x + 1 'go to the next row
Loop 'ends after z is reached
y = y + 1
Loop 'ends after column K is reached
I hope i can explain this well. I am having a difficulty in my code and what code should i use.
I have a big data, that needs to be filter first. and the range is not consistent.
after filtering data, i have to copy the second row (this is not to copy the Column name), until the last row with blanks.
I tried this code, but it didn't work
Sheets("Big5").Select
Range("P1").Select
Dim testlrow As Long
testlrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Dim rngBIGcode As Range
Set rngBIGcodeM = Range(Cells(ActiveCell.Row + 1, ActiveCell.Column), Cells(Rows.Count, ActiveCell.Column))
rngBIGcodeM.SpecialCells(xlCellTypeVisible).Cells(1).Select
Range(Selection, Selection.End(xlDown) & testlrow).Select
I have to copy the second row from P1, until the last row.
There are a few problems with your code, starting with using Select and ActiveCell. You also declare your range, then use a different name to Set. One way to ensure your variables are properly declared is to type Option Explicit above your Sub. Then it will verify your variables. Ensure that your objects are well-defined by using the worksheet variable in front of the cells. This is how your code could work:
Sub Test ()
Dim ws As Worksheet
Dim testlrow As Long
Dim rngBIGcodeM as Range
Set ws = Sheets("Big5")
testlrow = ws.Cells(Rows.Count, "P").End(xlUp).Row
Set rngBIGcodeM = ws.Range(ws.Cells(2, "P"), ws.Cells(testlrow, "P"))
rngBIGcodeM.SpecialCells(xlCellTypeVisible).Copy 'Enter Destination Here
Application.CutCopyMode = False
End Sub
I have a table of data which needs certain values to be changed based upon the value in column A. The data resides in a column headed Analysis\xx where xx is a variable value from 1 to 60. The number of columns varies per row, so that row 4 may go up to Analysis\4 whereas row 5 might go up to Analysis\30. Every value appearing in the Analysis\xx field needs to be updated, where a certain value exists in column A.
I have code to update values based upon a single fixed column position but I'm struggling to work out how to iterate through each row to update a variable number of columns.
Any suggestions would be gratefully received.
I've attached a sample of the data below which shows a good selection of the variation, with the columns that don't need amending hidden. Row 26 actually goes all the way to column NB.
Assuming your table has a name you can use the follwoing code to loop through each row off column A and in this case just print the value of a column in the same row.
Sub Tester()
Dim rg As Range
Dim rgA As Range
Dim sngCell As Range
Set rg = Range("Your TableName")
Set rgA = rg.Columns(1)
For Each sngCell In rgA.Rows
Debug.Print sngCell.Offset(, 3).Value2
Next
End Sub
Does that code go in the right direction?
EDIT: Assuming you use a listobject, this code might help you
Sub ChangeTable()
Const ACCT_NO = "ABCD1234"
Const HEADING = "Analysis*"
Const NEW_VAL = "80321"
Dim tbl As ListObject
Dim x As Long
Dim i As Long
Dim hdrCount As Long
Set tbl = ActiveSheet.ListObjects("Your Name here")
hdrCount = tbl.HeaderRowRange.Columns.Count
For x = 1 To tbl.ListRows.Count
With tbl.ListRows(x)
If .Range(1, 1).Value2 = ACCT_NO Then
For i = 2 To hdrCount
If tbl.HeaderRowRange(i).Value2 Like HEADING Then
.Range(1, i).Value = NEW_VAL
End If
Next
End If
End With
Next
End Sub
Hallo have you tried to use something like this for which TEST1 is the Varibale you like to replace and Test2 is the Variable you like to chnage it to ? This code does it for the entire Worksheet.
Sub Macro1()
Cells.Replace What:="TEST1", Replacement:="Test2", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub