I have been using this code to define a variable of a range that contains data. I then tried to use it to clear a worksheet (minus the headers) but it keeps showing that the last row is A2, when there is "ghost" data leftover from a previous paste in range W4 for example.
Why isn't this code finding the true last row? Even after I run this, then go to Find Special > Last Row - it finds the last pasted blank range (which is "empty"). You can see the variable LastRow is always "1". In the mean time, I've just been setting the delete range to A2:W5000 because I know I'll never have that much data, but it would be nice to have VBA find the true last row for me and store in a variable.
Thank you,
Public Sub ClearSheet()
Dim LastRow As Long
Dim LastCol As Long
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
MsgBox (LastRow)
MsgBox (LastCol)
Range("A2").Resize(LastRow, LastCol).EntireRow.Delete 'retains headers in A1:W1
Try the UsedRange function. UsedRange includes "ghost" cells, and you can manipulate it to delete unwanted rows, excluding the header, like so:
Sub RemoveUnwantedRows()
Dim wk As Worksheet
Set wk = ActiveSheet
Dim rng As Range
Set rng = wk.UsedRange
'Error handling incase there are no "Ghost Cells".
On Error Resume Next
Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
Set rng = rng.Offset(1, 0)
rng.Rows.Delete
On Error GoTo 0
'Proof that only the headers are left, you can leave this code out if you want.
wk.UsedRange.Select
End Sub
Related
I'm trying to delete a lot of rows in my Excel sheet.
My VBA is really simple:
Sub delNA()
lr = Cells(Rows.Count, "A").End(xlUp).Row 'find last row
For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
If Cells(i, "H").Text = "#N/A" Then Rows(i).EntireRow.Delete
Next i
End Sub
But my problem is that sometimes my headers are different. In this case the header BTEX (Sum) Is in H2, but sometimes that parameter is in G2 and sometimes it's in E2, so what I'm trying to do is make the VBA search for the header name, so instead of H the criteria is "BTEX (Sum)".
Is there a way to make the VBA run in the column where the value in row 2 is "BTEX (Sum)"
Give this a try:
Option Explicit
Sub delNA()
Const HEADER_TEXT As String = "BTEX (Sum)"
Dim thisSheet As Worksheet
Set thisSheet = ActiveSheet
With thisSheet
Dim myHeader As Range
Set myHeader = .Cells.Find(What:=HEADER_TEXT, after:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not myHeader Is Nothing Then 'i.e. we found the header text somewhere
Dim headerColumn As Long
headerColumn = myHeader.Column
Dim lastRow As Long
'Update here:
lastRow = .Cells(.Rows.Count, headerColumn).End(xlUp).Row 'find last row
Dim i As Long
For i = lastRow To 2 Step -1 'loop thru backwards, finish at 2 for headers
'Update here:
If IsError(.Cells(i, headerColumn).Value2) Then
.Rows(i).EntireRow.Delete
End If
Next i
Else
MsgBox ("Could not find a column for the header text " & HEADER_TEXT)
End If
End With
End Sub
It uses .Find() on the range to very quickly identify where your header column is and pops up an error message if it's not found (just in case)
NOTE: .Find() will use the current setting of anything in the Find dialog box that isn't explicitly set, and the next time you use the Find dialog box, the setting will be whatever they are set to by your code. i.e. the Find dialog box and the .Find() function share a common, persistent set of parameters.
It assigns a worksheet variable to the current worksheet, just to ensure that, if this should run a while, a bored user doesn't click on another worksheet and break stuff.
All worksheet rows explicitly reference thisSheet by using .Cells() and .Rows() (notice the leading .) because of the line: With thisSheet
It uses .Value2 instead of .text (See here for the reason.)
I declared Option Explicit at the beginning to ensure that all variables are declared before being used.
This is a good habit to be in as it will eliminate frustrating bugs from using MyText as a variable in one place and MyTxt as a variable somewhere else and not understanding why it isn't working.
You now have the framework to make a more generic function by converting the Const declaration to a parameter that is accepted by delNA() and you can use it for any header row instead of this fixed one.
#Mikkel Astrup you first just use an for loop to find the col index you are looking for, in this case col index of the cell in row 2 have value "BTEX (Sum)"
Dim lColumn,indexCol As Long
dim ws as worksheet
dim headerKey as string
set ws = thisworkbook.worksheets("Sheet1")
lColumn = ws.Cells(2, Columns.Count).End(xlToLeft).Column
headerKey = "BTEX (Sum)"
for indexCol = 1 to lColumn step 1
if ws.cells(2,indexCol).value = headerKey then
' your code ' indexCol is the index of col you are looking for'
exit for ' exit the loop now
end if
Next
Salutations bretheren! My name is Christopher.
Lately I've been racing through a stream of excel projects and I think I've overheated my brain. If you guys could bring me some cool water, it'd be much appreciated!
So I have a sheet which I was using as an inventory sheet, and it is non-interactive and dated. Not to mention I was storing inventory information for each part in multiple rows (graphically nice, not very functional.)
I've made a new (better) workbook already, so now I just want to take some of my old data and copy it to a new sheet (in the old workbook) that fits my new single-row format. I will be straight copying and pasting the information from that sheet into my new-and-improved workbook
I have some code which I will post at the end, and what I am trying to make it do is this:
In my Sheet1, I want AutoFilter to find the first text value "LOC" in column A, then offset to column B to get my part's location. Then it will offset one row down to get the part number. After that it will offset another two rows down to get the description.
In my Sheet2, I want to find the first empty row. Then I want the information I found in Sheet1 to be deposited into columns A, B, and C of that empty row.
I hope I have been quite specific, to the point and to a better effect not silly in the way I am asking for assistance!
Here I will post my code, and I am thankful for any and all recommendations, code tweaks, and help!
Thank you!
-Christopher
P.S. Beware, as you may laugh. My coding has been known to be laughable at times. I ALWAYS appreciate explanations of why something works, doesn't work, or why another thing that works would be better in a given circumstance!
Code:
Sub CopyStuff()
Dim iRow As Long
Dim ws As Worksheet
Dim Loc
Dim Part
Dim Desc
Set ws = Worksheets("Sheet2")
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With Sheets("Sheet2")
Set Part = iRow.Offset(0, 0)
Set Loc = iRow.Offset(0, 1)
Set Desc = iRow.Offset(0, 2)
End With
With Sheets("Sheet1")
.AutoFilter 1, "LOC"
.Offset(0, 1).Copy Loc
.Offset(1, 0).Copy Part
.Offset(2, 0).Copy Desc
.AutoFilter
End With
End Sub
In my Sheet1, I want AutoFilter to find the first text value "LOC" in column A, then offset to column B to get my part's location. Then it will offset one row down to get the part number.
You don't need Autofilter for this since you have to retrieve the value from multiple rows. Use .Find instead
Sub CopyStuff()
Dim wsIRow As Long, wsORow As Long
Dim wsI As Worksheet, wsO As Worksheet
Dim rng As Range, aCell As Range
Set wsI = Worksheets("Sheet1")
Set wsO = Worksheets("Sheet2")
wsORow = wsO.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
With wsI
wsIRow = wsI.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rng = .Range("A1:A" & wsIRow)
With rng
Set aCell = .Find(What:="LOC", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
wsO.Range("A" & wsORow).Value = aCell.Value
wsO.Range("B" & wsORow).Value = aCell.Offset(, 1).Value
wsO.Range("C" & wsORow).Value = aCell.Offset(1, 1).Value
End If
End With
End With
End Sub
Let's say Sheet1 looks like this
The output then will look like this
I am working on an Excel VBA Script to clean up a spreadsheet (first I remove lines with blanks, then I find/replace some text to be more summarized).
I would like to remove rows where the respondent did not answer any survey questions. The row does contain some data in the first few columns (A, B, C), such as their IP address , etc. The survey answers are located in column Q3 until column AC ( $Q4 to $AC) Here is screenshot :
But if user did not answer any survey question, I want to delete that row.
My VBA script is here :
Sub Main()
ReplaceBlanks
Multi_FindReplace
End Sub
Sub ReplaceBlanks()
On Error Resume Next
Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Sub Multi_FindReplace() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet Dim fndList As Variant
Dim rplcList As Variant Dim x As Long
fndList = Array("Mostly satisfied", "Completely satisfied", "Not at all satisfied")
rplcList = Array("satisfied", "satisfied", "unsatisfied")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub
When I run this without the error-handling in the ReplaceBlanks subroutine, I obtain this error message :
Run-time error '424': Object required
So far, only the second subroutine works (i.e Multi_FindReplace ). How do I fix the first subroutine, so that it removes the rows that don't have respondent answers ?
Replace this line,
Worksheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With this,
Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Either state the sheet you want to delete from by setting it or just start with Columns
The error you are getting is due to it not recognignising Worksheet you have before Columns("$Q:$AC")
You could do this if you need to specify the sheet you are deleteing from.
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Or even this
ActiveSheet.Columns("$Q:$AC").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
And as per comments, if you have multiple blanks cells you will throw an error, so if you have multiple blanks cells in one row and any cell that is blank determins the entire row to be deleted this code should do it for you.
Dim ws As Worksheet
Dim lastrow As Long
Dim rng As Range
Set ws = Sheets("Sheet1")
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If WorksheetFunction.CountA(ws.Range(ws.Cells(i, 17), ws.Cells(i, 21))) = 0 Then
If Not rng Is Nothing Then
Set rng = Union(ws.Cells(i, 1), rng)
Else
Set rng = ws.Cells(i, 1)
End If
End If
Next i
rng.EntireRow.Delete
My lazy way is usually to hide the non-blank rows, and delete the visible ones (not tested):
Cells.SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Cells.EntireRow.Hidden = False
I would like to copy and paste specific columns of a data set (table) with this two features:
data don't start in a known row
the number of observations is unknown (so is the number of rows with data)
I used the find function to get the ranges of the first and last cells with data, but then I can't figure out how to reference them in the copy function. The following is an example of what I want to do:
Sub prueba_copy()
Dim sht As Worksheet
Dim sht3 As Worksheet
Dim LastRow As Long
Dim FirstRow As Range
Set sht = ThisWorkbook.Worksheets(Sheet1.Name)
Set sht3 = ThisWorkbook.Worksheets(Sheet3.Name)
Set FirstRow = sht.Cells.Find("TIPO DE USO", searchorder:=xlByRows, LookAt:=xlPart) ' the result is range: F4
LastRow = sht.Cells.Find("*", after:=Cells(1, 2), searchorder:=xlByRows, searchdirection:=xlPrevious).Row 'the result is: 9
FirstRow and LastRow are going to be used to reference the range to copy. I want to copy the data from FirstRow to the column of FirstRow (e.i. F) and the row of LastRow (e.i. 9), so the action would read range(F4:F9).copy
'copy paste
sht.Range("FirstRow.address():Firstrow.addres().column" & LastRow).Copy sht3.Range("A1")
End Sub
I have tried many options to reference the ranges with no success. So, I would be really grateful for your help.
As I am new to this, I would also appreciate any suggestion of a good webpage to learn.
Thanks,
Gustavo
Dim f As range
Set f = Sheet1.Cells.Find("TIPO DE USO", searchorder:=xlByRows, LookAt:=xlPart)
If Not f Is Nothing Then
Sheet1.Range(f, Sheet1.Cells(Rows.Count, f.Column).End(xlUp)).Copy _
Sheet3.Range("A1")
Else
Msgbox "Header not found!"
End If
Try this code for copy-paste:
sht.Range(Cells(FirstRow.Row, FirstRow.Column), Cells(LastRow, FirstRow.Column)).Copy sht3.Range("A1")
The only thing that you are doing by using a worksheet's object to declare a worksheet variable is cluttering up the code. The exception would be to give the worksheet a more meaningful name, which you are not doing.
Dim Source As Range
With Sheet1
Set Source = .Cells.Find("TIPO DE USO", searchorder:=xlByRows, LookAt:=xlPart)
If Not Source Is Nothing Then
.Range(Source, Source.EntireColumn.Rows(.Rows.Count).End(xlUp)).Copy Sheet3.Range("A1")
End If
End With
Summary: My company has two different spreadsheets with many policies on each. They want me to match up policies by a policy ID and transfer all the old notes from the old spreadsheet to the new spreadsheet.
Reasoning: my issue is not with not understanding how to do this, but the BEST way to do this. Since joining StackOverflow I've been told things I should and shouldn't do. I've been told different times it is better to use a For Each loop instead of a simple Do loop. Also, I've been told I shouldn't use .Select heavily (but I do).
How I Would Normally Do It: I would normally just use a Do Loop and go through the data just selecting the data with .Find and using ActiveCell and when I wanted to interact with other Columns in that current row I would just use ActiveCell.Offset(). I tend to love .Select and use it all the time, however on this project I'm trying to push myself out of the box and maybe change some bad coding habits and start using what may be better.
Question: How would I go about doing the equivalent of an ActiveCell.Offset() when I'm using a For Each loop?
My Code So Far: **Questions/Criticisms welcome
Sub NoteTransfer()
transferNotes
End Sub
Function transferNotes()
Dim theColumn As Range
Dim fromSheet As Worksheet
Dim toSheet As Worksheet
Dim cell As Range
Dim lastRow As Integer
Set fromSheet = Sheets("NotesFrom")
Set toSheet = Sheets("NotesTo")
With fromSheet 'FINDING LAST ROW
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Set theColumn = fromSheet.Range("B5:B" & lastRow)
For Each cell In theColumn 'CODE FOR EACH CELL IN COLUMN
If cell.Text = "" Then
'do nothing
Else
With toSheet 'WANT TO FIND DATA ON THE toSheet
Cells.find(What:=cell.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End With
End If
Next cell
End Function
Example
Bottom of the sheet
First, your question:
Question: How would I go about doing the equivalent of an ActiveCell.Offset() when I'm using a For Each loop?
Doesn't make much sense given the code you posted. It's a very general question, and would need some context to better understand. It really depends on your loop. If you are looping a contiguous range of cells from the ActiveCell then you could say ...
For each cel in Range
myValue = ActiveCell.Offset(,i)
i = i + 1
Next
To get the column next to each cell in the loop. But in general I wouldn't call that great programming. Like I said, context is important.
As far as your code goes, see if this makes sense. I've edited and commented to help you a bit. Oh yeah, good job not using Select!
Sub transferNotes() '-> first no need for a function, because you are not returning anything...
'and no need to use a sub to call a sub here as you don't pass variables,
'and you don't have a process you are trying to run
Dim theColumn As Range, cell As Range '-> just a little cleaner, INMHO
Dim fromSheet As Worksheet, toSheet As Worksheet '-> just a little cleaner, INMHO
Dim lastRow As Integer
Set fromSheet = Sheets("NotesFrom")
Set toSheet = Sheets("NotesTo")
With fromSheet ' -> put everything you do in the "fromSheet" in your With block
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row 'FINDING LAST ROW
Set theColumn = .Range("B5:B" & lastRow)
theColumn.AutoFilter 1, "<>"
Set theColumn = theColumn.SpecialCells(xlCellTypeVisible) '-> now you are only looping through the cells are that are not blank, so it's more efficient
For Each cell In theColumn
'-> use of ActiveCell.Offset(), it's not ActiveCell.Offset(), but it uses Offset
Dim myValue
myValue = cell.Offset(, 1) '-> gets the cell value in the column to the right of the code
'WANT TO FIND DATA ON THE toSheet
toSheet.Cells.Find(What:=cell.Text, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Next cell
End With
End Sub
This is my suggestion so far.
Function transferNotes()
Dim SourceColumn As Range
Dim fromSheet As Worksheet
Dim toSheet As Worksheet
Dim cell As Range
Dim lastRow As Long '<--changed to Long
Set fromSheet = Sheets("NotesFrom")
Set toSheet = Sheets("NotesTo")
With fromSheet 'FINDING LAST ROW
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Set SourceColumn = fromSheet.Range("B5:B" & lastRow)
For Each cell In SourceColumn 'CODE FOR EACH CELL IN COLUMN
If cell.Value = "" Then 'the .Text property can
'make for some confusing errors.
'Try to avoid it.
'nothng to search for
Else
With toSheet 'WANT TO FIND DATA ON THE toSheet
Dim destRng As Range
Set destRng = .Range("A:A").Find(What:=cell.Value)
If Not destRng Is Nothing Then
.Cells(destRng.Row, <your mapped column destination>)
= fromSheet.Cells(cell.Row,<your mapped column source>)
' you can either repeat the above line for all of your non-contiguous
'sections of data you want to move from sheet to sheet
'(i.e. if the two sheets are not arranged the same)
'if the two sheets are aranged the same then change
'the .cells call to call a range and include
'the full width of columns
Else
'nothing was found
End If
End With
End If
Next cell
End Function