I need to get the last column number on the second row, while the cited column is hidden.
The below code outputs wrong result if the last column is hidden.
Sub Last_column_number_even_is_hidden()
Dim ws As Worksheet, lastCol_n As Long
Set ws = ActiveSheet
lastCol_n = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
MsgBox ("Last column number is " & lastCol_n)
End Sub
It looks that only Find does not care about the hidden cells in a range...
Please, try the next way:
Sub testLastColEvenHidded()
Dim ws As Worksheet, lastCol_n As Long, rng2 As Range
Set ws = ActiveSheet
Set rng2 = ws.UsedRange.rows(2)
lastCol_n = rng2.Find(What:="*", After:=rng2.cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
Debug.Print lastCol_n
End Sub
UsedRange may be not reliable, but only adding to the range... So, using it you can extract a full slice of a specific row to process it using Find, which does not care about not visible cells.
Related
I've got Workbook where I got names and hours worked of employees. I'm looking for comparing rows in one worksheet (Range B6:CC6) and find it in another with selection on cell with employee name (Range A1:A5000) when I change sheets from 1 to 2.
Tried some Range.Find and others, no idea how to do it
Public Sub FindPosition()
Dim Actcol As Integer, Pos As Range, Name As Range
Actcol = ActiveCell.Column
MsgBox "ActiveCell is" & Actcol
Set Pos = Cells(6, Actcol)
MsgBox Pos
Pos.Select
If Worksheets("Sheet2").Activate Then
Worksheets("Sheet2").Range("A1:AA5100").Select
Set Name = Selection.Find(Pos, LookIn:=xlValues)
End If
End Sub
First, if you want to trigger some macro by activation of Sheet2, you need to handle Activate event of Sheet2. This can be done by declaring subroutine in Sheet module like this.
Private Sub Worksheet_Activate()
'Codes you want to be run when Sheet2 is activated.
End Sub
Second, a simple way to find a cell with specific value is to use WorksheetFunction.Match. For example,
Dim SearchInRange As Range
Set SearchInRange = Range("A1:A5000")
Dim EmployeeName As Variant
EmployeeName = ... 'Actual employee name you want to search
On Error GoTo NotFound
Dim Index As Variant
Index = WorksheetFunction.Match(EmployeeName, SearchInRange, 0)
On Error GoTo 0
SearchInRange.Cells(Index).Select
GoTo Finally
NotFound:
' Handle error
Finally:
Range.Find may also work, but remember it has the side effect of changing the state of "Find and Replace" dialog box.
This may helps you
Option Explicit
Sub test()
Dim i As Long, LastRowA As Long, LastRowB As Long
Dim rngSearchValues As Range, rngSearchArea As Range
Dim ws1 As Worksheet, ws2 As Worksheet
'Set you worksheets
With ThisWorkbook
'Let say in this worksheet you have the names & hours
Set ws1 = .Worksheets("Sheet1")
'Let say in this worksheet you have the list of names
Set ws2 = .Worksheets("Sheet2")
End With
'Find the last row of the column B with the names from the sheet with names & hours
LastRowB = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
'Find the last row of the column A with the names from the sheet with list of names
LastRowA = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'Set the range where you want to check if the name appears in
Set rngSearchArea = ws2.Range("A1:A" & LastRowA)
'Loop the all the names from the sheet with names and hours
For i = 6 To LastRowB
If ws1.Range("B" & i).Value <> "" Then
If Application.WorksheetFunction.CountIf(rngSearchArea, "=" & ws1.Range("B" & i).Value) > 0 Then
MsgBox "Value appears"
Exit For
End If
End If
Next i
End Sub
Oh right, I found solution. Thanks everyone for help.
Public Sub Position()
Dim Accol As Integer
Dim Pos As Range
Dim name As Range
ActiveSheet.name = "Sheet1"
Accol = ActiveCell.Column
Set Pos = Cells(6, Accol)
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("a1:a5000").Select
Set name = Selection.Find(What:=Pos, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
name.Select
End Sub
Last thing I would like to do which I cannot solve is where do I write automatically script running when I choose Sheet2?
I want to delete a row within a range (not entire row) based on a criterion.
I am 90% there, however, the formatting of the data is holding me back somewhat.
The code below works well, it deletes the range ("I: Q") if the value in column "I" equals the value in cell "E2". However, there are blank rows within my data range (I: Q) that act as separators and therefore cannot be removed.
In the case of the first row being blank, the code stops and thinks it has finished its job. When actually it has done nothing.
Sub deleteb2()
Dim FindRng As Range
Dim Rng1 As Range
Dim LastRow As Long
Dim TexttoFind As Integer
Dim TexttoFind1 As String
With Sheets("DN Compile")
TexttoFind = .Range("E2").Value
later
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row '<-- get last row with
data in Column E
Set Rng1 = .Range("I1:Q" & LastRow)
Set FindRng = Rng1.Find(What:=TexttoFind, LookIn:=xlValues,
LookAt:=xlWhole)
While Not FindRng Is Nothing '<-- find was successful
FindRng.Resize(, 10).delete xlShiftUp '<-- delete column "I:Q" in
found row
Set FindRng = Rng1.Find(What:=TexttoFind, LookIn:=xlValues,
LookAt:=xlWhole)
Wend
End With
End Sub
My thinking was to somehow add an IF statement, that would cause the code to carry on looking, if for example, up to 5 consecutive blank rows are seen by the code and only then, it would stop looking further.
The code now works - I made one little adjustment and it seems to be working fine for me!
Here is what I changed:
LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row '<-- get last row with data in Column E
i.e I changed the last row line of code to count column I instead of column E.
Not sure if I should just delete the question, but thought since the code works it could be useful.
Sub deleteb2()
Dim FindRng As Range
Dim Rng1 As Range
Dim LastRow As Long
Dim TexttoFind As Integer
Dim TexttoFind1 As String
With Sheets("DN Compile")
TexttoFind = .Range("E2").Value
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row '<-- get last row with data in Column E
Set Rng1 = .Range("I1:Q" & LastRow)
Set FindRng = Rng1.Find(What:=TexttoFind, LookIn:=xlValues, LookAt:=xlWhole)
While Not FindRng Is Nothing '<-- find was successful
.Range("i" & FindRng.Row).Resize(1, 10).Delete xlShiftUp '<-- Set range based on i column.
Set FindRng = Rng1.Find(What:=TexttoFind, LookIn:=xlValues, LookAt:=xlWhole)
Wend
End With
End Sub
EDIT: I may have spotted an issue as soon as posting it the myRange
variables dont seem to be doing anything - so I'm feeling they were
there from a method i was using ages ago and there decided to crop out
I'll remove the whole myRange variable and see what happens
Set myRange = ActiveSheet.Range("1:1")
Set myRange = ActiveSheet.Range("A:A")
EDIT 2: Ok so changing the numCols and numRows functions to only use
numCols = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
numRows = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
They now return the correct row and Column numbers
But now when I run selectBlock() it gives me runtime error 28 "Out of Stack Space"
Hello All, I've been writing code to be able to go through multiple sheets and copy the data across to a master workbook
Im coding this to work on any file depending what you pass to it - which has been fine
What im having problems with is the Functions I have made which find the last populated row for any sheet I pass to it
Sub test()
selectBlock().Select
End Sub
Function selectBlock() As Range
Dim row As Integer: row = numRows() 'Finds last populated row
Dim col As Integer: col = numCols() 'Finds last populated column
Set selectBlock() = Range("A2:" & Cells(row, col).Address)
'sets this area starting from cell A2 as the Range
End Function
Function numCols() As Integer
Dim myRange As Range
Set myRange = ActiveSheet.Range("1:1") 'Checks first row to see how many populated columns there are
numCols = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
End Function
Function numRows() As Integer
Dim myRange As Range
Set myRange = ActiveSheet.Range("A:A") 'Checks first columns to see how many populated rows there are
numRows = Range("A" & Rows.Count).End(xlUp).row
End Function
When I call the test Sub it causes Excel to hang then crash with no error code
So i imagine im creating some kind of loop or critical error that isnt handled by excel very well
Any help with this would be really appreciated
I can also understand if how im going about it is incredibly stupid
I used to code in Java and maybe im using techniques or pitfalls that I never got rid of - Im self taught at VBA like most and so never learnt official coding practices for VBA
Lot of things here
Fully qualify your cells
Use Long and not Integer when working with row and columns
Use error handling. This will avoid the Excel crashing.
Try this
Sub test()
On Error GoTo Whoa
selectBlock().Select
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Function selectBlock() As Range
Dim row As Long: row = numRows() 'Finds last populated row
Dim col As Long: col = numCols() 'Finds last populated column
Set selectBlock = ActiveSheet.Range("A2:" & ActiveSheet.Cells(row, col).Address)
End Function
Function numCols() As Long
numCols = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
End Function
Function numRows() As Long
numRows = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).row
End Function
Replace
Set selectBlock() = Range("A2:" & Cells(row, col).Address)
to
Set selectBlock = Range("A2:" & Cells(row, col).Address)
it looks recursive :P
There are safer ways to find the LastRow and LastCol, I like the Find function.
See more detailed in my code's comments.
Code
Sub test()
Dim Rng As Range
Set Rng = selectBlock
Rng.Select '<-- Not sure why you need to Select ?
End Sub
'============================================================
Function selectBlock() As Range
Dim LastRow As Long
Dim LastCol As Long
LastRow = FindLastRow(ActiveSheet) 'Finds last populated row
LastCol = FindLastCol(ActiveSheet) 'Finds last populated column
Set selectBlock = Range(Cells(2, "A"), Cells(LastRow, LastCol))
End Function
'============================================================
Function FindLastCol(Sht As Worksheet) As Long
' This Function finds the last col in a worksheet, and returns the column number
Dim LastCell As Range
With Sht
Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
If Not LastCell Is Nothing Then
FindLastCol = LastCell.Column
Else
MsgBox "Error! worksheet is empty", vbCritical
End
End If
End With
End Function
'============================================================
Function FindLastRow(Sht As Worksheet) As Long
' This Function finds the last row in a worksheet, and returns the row number
Dim LastCell As Range
With Sht
Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not LastCell Is Nothing Then
FindLastRow = LastCell.row
Else
MsgBox "Error! worksheet is empty", vbCritical
End
End If
End With
End Function
I'm kind of new to VBA and am struggling to understand some of the syntax.
I have a range from a3:c13, for example, and I'd like to set it as a variable so I can pass it to vlookup later as a the table array. However, the range is defined by user input in terms of its size. It will always start in A3, it will always include columns A:C, but I don't know how far down it would go. In that case, I think I'd set it as:
With range("a3")
table_array = range(.cells(0,0), .End(xlDown).End(xlToRight)).Select
End With
However, that doesn't seem to work. I get a runtime error:
Run-time Error '1004': Method '_Default' of object 'Range' failed.
Assuming cols A, B, and C have the same number of rows:
Sub Macro1()
Set r = Range("A3")
Set table_array = Range(r, r.End(xlDown)).Resize(, 3)
End Sub
You can find the last row in Col A:C and then construct your range?
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim Rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Range("A:C").Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
If Not LastRow < 3 Then
Set Rng = .Range("A3:C" & LastRow)
Debug.Print Rng.Address
Else
MsgBox "No Data found beyond A3"
End If
End With
End Sub
I am trying to delete a row if there is no data from A:J
I have found this code and been trying to edit it, but this is deleting the whole sheet's data eventually.
Any help would be greatly appreciated
Sub DeleteRows()
Dim rngBlanks As Range
Dim i As Integer
For i = 1 To 10
On Error Resume Next
Set rngBlanks = Columns(i).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngBlanks Is Nothing Then
rngBlanks.EntireRow.Delete
End If
Next
End Sub
Trying to delete a row if no data in row A:J
What code is doing is individually checking the columns and not the range A:J as your title suggests. It is very much possible that your entire data is getting deleted because of this. Lets say A1 has some data but B1 doesn't. So your code will delete Row 1. What you have to do is to check if say A1:J1 is blank.
I think this is what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rngBlanks As Range
Dim i As Long, lRow As Long, Ret As Long
'~~> Set this to the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
'~~> Get the last row in that sheet
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
'~~> Loop through the rows to find which range is blank
For i = 1 To lRow
Ret = Application.Evaluate("=COUNTA(A" & i & ":J" & i & ")")
If Ret = 0 Then
If rngBlanks Is Nothing Then
Set rngBlanks = .Rows(i)
Else
Set rngBlanks = Union(rngBlanks, .Rows(i))
End If
End If
Next i
End With
'~~~> Delete the range
If Not rngBlanks Is Nothing Then rngBlanks.Delete
End Sub
Another way would be to use Autofilter to delete those ranges
I stepped through your code with a sheet having some non-blank cells in columns A:J down to row 15. Rows 16:18 were entirely blank and D19=1. You want to delete rows that have blanks in every cell from A:J.
On the first iteration of your For..Next loop rngBlanks was not Nothing because typing
?rngBlanks.address
returned $A$1,$A$5:$A$19. A2:A4 were not blank. When you execute
Set rngBlanks = Columns(i).SpecialCells(xlCellTypeBlanks)
it looks for any blanks in column A which is not what you wanted to test. You want to test each row, probably within your ActiveSheet.UsedRange to see if columns A:J are all blank. So you need to define a variable
Dim Rw as Range
and iterate through each Rw in UsedRange
For Each Rw in ActiveSheet.UsedRange
If WorksheetFunction.CountBlank(range(cells(Rw,1),cells(Rw,10))) =0 Then
Rw.EntireRow.Delete
I could post the entire code here but what I've given should put you on the right track.