Excel VBA Compact method to insert text in offset column based on FIND result - excel

I am writing a small timesaver tool that inserts various text values in a column based on a cell offset of the location of a list-based text search in column C.
Dim C1 As Range
Set C1 = Range("B:B").Find("Value to search")
If C1 Is Nothing Then
Else
C1.Offset(0, -1).Value = "Text value to insert"
End If
I am certain there is a better way to write this relatively simple proc in a more scalable way rather than hard code each value to search in the code, but am not sure how this could be simplified further. I've been looking at the first two lines, and I may be wrong, but I believe a cell range needs to be defined as written in the first two lines in order for the Offset to know the cell location to offset from.

Depends on how you are planning on running this. You could have it as a sub that prompts a user to enter the search value and the text to input at offset. I show that below. It is easy enough instead to adapt to a loop if you have the search and offset strings in the sheet. I use only the populated area of column B for the search. The search values and insert/offset values are held in variables.
Option Explicit
Public Sub AddText()
Dim searchValue As String, insertValue As String, C1 As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
searchValue = Application.InputBox("Please supply search value", Type:=2)
insertValue = Application.InputBox("Please supply insert value", Type:=2)
If searchValue = vbNullString Or insertValue = vbNullString Then Exit Sub 'or loop prompting for entry
With ws
Set C1 = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Find(searchValue)
End With
If Not C1 Is Nothing Then C1.Offset(0, -1).Value = insertValue
End Sub
Edit:
From your comment you are actually just doing a VLOOKUP.
In sheet 2 A1 put the following and autofill down for as many rows as are filled in column B.
=IFERROR(VLOOKUP(B1,Sheet1!A:B,2,FALSE),"")
Same thing using arrays and a dictionary
Option Explicit
Public Sub AddText()
Dim wsSource As Worksheet, wsSearch As Worksheet
Dim lookupArray(), updateArray(), lookupDict As Object, i As Long
Set lookupDict = CreateObject("Scripting.Dictionary")
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsSearch = ThisWorkbook.Worksheets("Sheet2")
With wsSource
lookupArray = .Range("A1:B" & GetLastRow(wsSource, 1)).Value
End With
For i = LBound(lookupArray, 1) To UBound(lookupArray, 1)
lookupDict(lookupArray(i, 1)) = lookupArray(i, 2)
Next
With wsSearch
updateArray = .Range("A1:B" & GetLastRow(wsSearch, 2)).Value
For i = LBound(updateArray, 1) To UBound(updateArray, 1)
If lookupDict.Exists(updateArray(i, 2)) Then
updateArray(i, 1) = lookupDict(updateArray(i, 2))
End If
Next
.Cells(1, 1).Resize(UBound(updateArray, 1), UBound(updateArray, 2)) = updateArray
End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function

Related

Change color of cells if the value matches values of other worksheets values in a column

So here's the code. I have a calendar with dates in B4:H9. I want to change the color of the cells if the those dates are in a list (column, on different worksheet).
This might be a bit heavy to run if there are many different dates in the worksheet, but that doesn't matter.
What am I doing wrong here? It keeps giving me different error codes, when trying different things.
Sub check_Click()
Dim area As Range
Dim item1 As Range
Dim item2 As Range
Dim sheet As Worksheet
Dim columnlist As Range
sheet = Range("E2").Value
area = Range("B4:H9")
columnlist = Worksheets(sheet).Range("A2:A" & Rows.Count)
For Each item1 In area
For Each item2 In columnlist
If item1.Value = item2.Value Then
item1.Interior.ColorIndex = RGB(255, 255, 0)
End If
Next item2
Next item1
End Sub
As SuperSymmetry mentioned, when you define objects (e.g. ranges, sheets) you need to use the Set keyword. I will not get into that explanation. However few things that I would like to mention...
Try and give meaningful variable names so that you can understand what are they for.
Work with objects so that your code knows which sheet, which range are you referring to.
No need of 2nd loop. Use .Find to search for your data. It will be much faster
To set RGB, you need .Color and not .ColorIndex
Is this what you are trying? (Untested)
Option Explicit
Sub Check_Click()
Dim rngData As Range
Dim rngReference As Range
Dim aCell As Range
Dim matchedCell As Range
Dim ws As Worksheet
Dim lastRow As Long
Dim worksheetName As String
'~~> Change the sheet name accordingly
worksheetName = ThisWorkbook.Sheets("Sheet1").Range("E2").Value
Set ws = ThisWorkbook.Sheets(worksheetName)
With ws
'~~> Find the last row in Col A
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Set your range
Set rngData = .Range("B4:H9")
Set rngReference = .Range("A2:A" & lastRow)
'~~> Loop through your data and use .Find to check if the date is present
For Each aCell In rngData
Set matchedCell = rngReference.Find(What:=aCell.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not matchedCell Is Nothing Then
'~~> Color the cell
matchedCell.Interior.Color = RGB(255, 255, 0)
End If
Next aCell
End With
End Sub
This should do the trick, I don't like leaving ranges without their sheet, but since I believe you are using a button, there should be no problem:
Option Explicit
Sub check_Click()
'We are going to use a dictionary, for it to work you need to:
'Go to Tools-References-Check the one called: Microsoft Scripting Runtime
Dim DatesToChange As Dictionary: Set DatesToChange = LoadDates
Dim area As Range: Set area = Range("B4:H9")
Dim item As Range
For Each item In area
If DatesToChange.Exists(item.Value) Then
item.Interior.Color = RGB(255, 255, 0)
End If
Next item
End Sub
Private Function LoadDates() As Dictionary
Set LoadDates = New Dictionary
Dim arr As Variant: arr = ThisWorkbook.Sheets(Range("E2")).Range("A:A")
Dim i As Long
For i = 2 To UBound(arr)
'This here will break the loop when finding an empty cell in column A
If arr(i, 1) = vbNullString Then Exit For
'This will add all your dates in a dictionary (avoiding duplicates)
If Not LoadDates.Exists(arr(i, 1)) Then LoadDates.Add arr(i, 1), 1
Next i
End Function
When you define objects (e.g. ranges, sheets) you need to use the Set keyword
Set area = Range("B4:H9")
Set columnlist = Worksheets(sheet).Range("A2:A" & Rows.Count)
Worksheets() accepts either an Integer or a String. Therefore, sheet should be of Type String
Dim sheet As String
You're also setting columnlist to the whole column in the sheet so you're looping hundreds of thousands more times unncessarily. Change it to
With Worksheets(sheet)
Set columnlist = .Range(.Range("A2"), .Range("A" & Rows.Count).Offset(xlUp))
End With
The above should fix the errors in your code and make it run a little faster. However, there's still big room for improvment in the efficiency of the code. For example, instead of changing the colour inside the loop, you should build a range and set the colour one time after the loop.
Also consider resetting the colour at the beginning of the code with
area.Interior.Pattern = xlNone
I would personally go with conditional formatting as #SiddharthRout suggested in the comments.
Edit following comment
Here's my rendition
Sub check_Click()
Dim dStart As Double
dStart = Timer
Dim rngCalendar As Range
Dim vCalendar As Variant
Dim shtDates As Worksheet
Dim vDates As Variant, v As Variant
Dim i As Long, j As Long
Dim rngToColour As Range
' Change the sheet name
With ThisWorkbook.Sheets("Calendar")
Set rngCalendar = .Range("B4:H9")
vCalendar = rngCalendar.Value
Set shtDates = ThisWorkbook.Sheets(.Range("E2").Value)
End With
With shtDates
vDates = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Value
End With
For i = 1 To UBound(vCalendar, 1)
For j = 1 To UBound(vCalendar, 2)
For Each v In vDates
If v <> vbNullString And v = vCalendar(i, j) Then
If rngToColour Is Nothing Then
Set rngToColour = rngCalendar.Cells(i, j)
Else
Set rngToColour = Union(rngToColour, rngCalendar.Cells(i, j))
End If
Exit For
End If
Next v
Next j
Next i
rngCalendar.Interior.Pattern = xlNone
If Not rngToColour Is Nothing Then
rngToColour.Interior.Color = RGB(255, 255, 0)
End If
MsgBox "Time taken: " & Format(Timer - dStart, "0.0000s")
End Sub
With a list of 2500 dates it took 0.0742s on my machine.

How can I place a formula in the first empty cell on Column F?

How can I place a formula in the first empty cell on Column F?
F3 is empty cell.
Need for that empty cell be =F2
Note: I'm looking for code to look for first empty cell F and I need to be able to insert in the first empty cell =F3.
Currently working with following code copied from here
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = 6 'column F has a value of 6
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
'for every row, find the first blank cell and select it
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Select
Exit For 'This is missing...
End If
Next
Your existing code implies you want to consider truely Empty cells and cells that contain an empty string (or a formula that returns an empty string) Note 1. (Given you simply copied that code from elsewhere, that may not be the case)
You can use End(xlDown) to locate the first truely Empty cell, or Match to locate the first "Empty" cell in a range (either just empty string, or either empty strings or Empty cells, in different forms)
If you want to find the first truely Empty cell, or cell containing an empty string:
Function FindFirstEmptyOrBlankCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty or blank cell
Set FindFirstEmptyOrBlankCell = rng.Cells(StartingAt.Worksheet.Evaluate("Match(True, " & rng.Address & "=""""" & ", 0)"), 1)
End Function
If you want to find the first truely Empty cell, and ignore cells containing an empty string:
Function FindFirstEmptyCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty cell
If IsEmpty(StartingAt.Cells(1, 1)) Then
Set FindFirstEmptyCell = rng.Cells(1, 1)
ElseIf IsEmpty(StartingAt.Cells(2, 1)) Then
Set FindFirstEmptyCell = rng.Cells(2, 1)
Else
Set FindFirstEmptyCell = rng.End(xlDown).Cells(2, 1)
End If
End Function
And for completeness, if you want to find the fisrt cell containing an empty string, and ignore truely Empty cells:
Function FindFirstBlankCell(StartingAt As Range) As Range
Dim rng As Range
Dim idx As Variant
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first blank cell
idx = Application.Match(vbNullString, rng, 0)
If IsError(idx) Then
'There are no Blank cells in the range. Add to end instead
Set FindFirstBlankCell = rng.Cells(rng.Rows.Count, 1)
Else
Set FindFirstBlankCell = rng.Cells(idx, 1)
End If
End Function
In all cases, call like this
Sub Demo()
Dim ws As Worksheet
Dim r As Range
Set ws = ActiveSheet '<~~~ or specify required sheet
Set r = FindFirstEmptyOrBlankCell(ws.Range("F3"))
' literally what was asked for
'r.Formula = "=F3"
' possibly what was actually wanted
r.Formula = "=" & r.Offset(-1, 0).Address(0, 0)
End Sub
Note 1
If IsEmpty(currentRowValue) Or currentRowValue = "" Then is actually redundant. Any value that returns TRUE for IsEmpty(currentRowValue) will also return TRUE of currentRowValue = "" (The reverse does not apply)
From comment can that same Fuction repeat until the last empty cel? I think this is what you mean is to continue to fill blank cells down through the used range
If so, try this
Sub Demo()
Dim ws As Worksheet
Dim cl As Range
Dim r As Range
Set ws = ActiveSheet '<~~~ or specify required sheet
Set cl = ws.Range("F3")
Do
Set r = FindFirstEmptyOrBlankCell(cl)
If r Is Nothing Then Exit Do
r.Formula = "=" & r.Offset(-1, 0).Address(0, 0)
Set cl = r.Offset(1, 0)
Loop
End Sub
Note, I've modified FindFirstEmptyOrBlankCell above to aloow it to return Nothing when it needs to:
Function FindFirstEmptyOrBlankCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty or blank cell
On Error Resume Next ' Allow function to return Nothing
Set FindFirstEmptyOrBlankCell = rng.Cells(StartingAt.Worksheet.Evaluate("Match(True, " & rng.Address & "=""""" & ", 0)"), 1)
End Function
You'll need to change your rowCount, the way you have it, the loop will stop before the first blank row. I believe you should just be able to set use .Formula for the empty cell. Hope this helps:
Sub EmptyCellFillFormula()
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = 6 'column F has a value of 6
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row + 1
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Formula = "=F3"
End If
Next
End Sub

Vlookup from another sheet and paste the result in another sheet

I need a help with a vlookup using vba as I was not able to find the solution on the web
The situation is I have three sheets
Sheet 1: Lookup value in cell B3 with a name
Sheet 1
Sheet 2: Lookup table with column name and surname
Sheet 2
Sheet 3: Result of the lookup value in cell B3 with surname
Sheet 3
You can refer to the images for better understanding
So the value in sheet 1 is my lookup value and the surname has to be printed in the sheet 3 and the table array is in sheet 2
The code which I tried is
Sub nameloopkup()
Dim name As String
Dim result As String
Dim myrange As Range
name = Worksheets("Sheet1").Range("B3").Value
myrange = Worksheets("Sheet2").Range("A:B").Value
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
' the query does not run and i don't know how can i print the result in sheet 3
End sub
This might be quiet simple for many around here. But considering my amature level to VBA, I need some guidance regarding the same.
Any kind of help or suggestion is appreciated.
Actuall all you need to do is:
Sub nameloopkup()
Dim Name As String
Dim Result As String
Dim SearchIn As Variant 'variant to use it as array
Name = Worksheets("Sheet1").Range("B3").Value
SearchIn = Worksheets("Sheet2").Range("A:B").Value 'read data into array
On Error Resume Next 'next line errors if nothing was found
Result = Application.WorksheetFunction.VLookup(Name, SearchIn, 2, False)
On Error Goto 0
If Result <> vbNullString Then
Worksheets("Sheet3").Range("B3").Value = Result
Else
MsgBox "Nothing found"
End If
End Sub
Alternatively just write a formula:
Sub NameLookUpFormula()
Worksheets("Sheet3").Range("B3").Formula = "=VLOOKUP(Sheet1!B3,Sheet2!A:B,2,FALSE)"
End Sub
Here is what you could 2... There are 2 options, if you only need 1 entry of data, or if you need a whole array of data and picking each time what you need from it:
Option Explicit
Sub nameloopkup()
Dim C As Range, LastRow As Long, EmptyRow As Long, i As Long, arrData
Dim DictData As New Scripting.Dictionary 'You need to check Microsoft Scripting Runtime from references for this
Dim wsNames As Worksheet, wsTable As Worksheet, wsSurnames As Worksheet
'First thing, reference all your sheets
With ThisWorkbook
Set wsNames = .Sheets("Sheet1") 'change this as needed
Set wsTable = .Sheets("Sheet2")
Set wsSurnames = .Sheets("Sheet3")
End With
'Keep all the data in one dictionary:
With wsTable
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'last row on Sheet2
i = .Cells(1, .Columns.Count).End(xlToLeft).Column 'last column on Sheet2
arrData = .Range(.Cells(1, 1), .Cells(LastRow, i)).Value 'keep the data on the array
'This will throw an error if there are duplicates
For i = 2 To UBound(arrData)
DictData.Add arrData(i, 1), i 'keep tracking of every name's position ' also change for arrData(i, 2) if you only need the surname
Next i
End With
With wsNames
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'last row on Sheet1
For Each C In .Range("B3:B" & LastRow)
EmptyRow = wsSurnames.Cells(wsSurnames.Rows.Count, 1).End(xlUp).Row
wsSurnames.Cells(EmptyRow, 2) = DictData(C.Value) 'if you used arrData(i, 2) instead i
wsSurnames.Cells(EmptyRow, 2) = arrData(DictData(C.Value), 2) 'If you used i
Next C
End With
End Sub
myrange = Worksheets("Sheet2").Range("A:B").Value
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
Here is your error. The second argument of Vlookup is a Range, not a String. As a range is an object, you also need to Set it:
Set myrange = Worksheets("Sheet2").Range("A:B")
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)

Search column headers and insert new column using Excel VBA

I have a spreadsheet that is updated regularly. Therefore the column header positions change regularly. eg. today "Username" is column K, but tomorrow "Username" might be column L. I need to add a new column to the right of "Username" but where it changes I cannot refer to as cell/column reference.
So far I have:
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find("Username")
When I go to add a new column to the right of it, I'm selecting that row but it's going back to cell/column references...
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Role"
How can I perform this step with a macro?
edit: I think need to give that Column a header name and begin populating the row with data - each time I do begins the cell references which I want to avoid wherever possible.
Many thanks in advance.
How about:
Sub qwerty()
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find(what:="Username", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "role"
End Sub
Sub AddColumn
Dim cl as Range
For each cl in Range("1:1")
If cl = "username" Then
cl.EntireColumn.Insert Shift:= xlToRight
End If
cl.Offset(0, 1) = "role"
Next cl
End Sub
Untested code as not at my desktop
Something like this should work. The idea is that you locate the column and then you insert to the right. That is why you have the +1 in the TestMe. The function l_locate_value_col returns the column, where it has found the value. If you want, you may change the optional parameter l_row, depending on which row do you want to look for.
Option Explicit
Public Sub TestMe()
Dim lngColumn As Long
lngColumn = l_locate_value_col("Username", ActiveSheet)
Cells(1, lngColumn + 1).EntireColumn.Insert
End Sub
Public Function l_locate_value_col(target As String, _
ByRef target_sheet As Worksheet, _
Optional l_row As Long = 1)
Dim cell_to_find As Range
Dim r_local_range As Range
Dim my_cell As Range
Set r_local_range = target_sheet.Range(target_sheet.Cells(l_row, 1), target_sheet.Cells(l_row, Columns.Count))
For Each my_cell In r_local_range
If target = Trim(my_cell) Then
l_locate_value_col = my_cell.Column
Exit Function
End If
Next my_cell
l_locate_value_col = -1
End Function
You could name your range:
Sub Test()
Dim rngUsernameHeader As Range
'UserName is in column F at the moment.
Set rngUsernameHeader = Range("UserName")
Debug.Print rngUsernameHeader.Address 'Returns $F$1
ThisWorkbook.Worksheets("Sheet2").Range("E:E").Insert Shift:=xlToRight
Debug.Print rngUsernameHeader.Address 'Returns $G$1
End Sub
Edit:
Have rewritten so it inserts a column after your named column and returns that reference:
Sub Test()
Dim rngUsernameHeader As Range
Dim rngMyNewColumn As Range
Set rngUsernameHeader = Range("UserName")
rngUsernameHeader.Offset(, 1).Insert Shift:=xlToRight
'You'll need to check the named range doesn't exist first.
ThisWorkbook.Names.Add Name:="MyNewRange", _
RefersTo:="='" & rngUsernameHeader.Parent.Name & "'!" & _
rngUsernameHeader.Offset(, 1).Address
Set rngMyNewColumn = Range("MyNewRange")
MsgBox rngMyNewColumn.Address
End Sub

Excel VBA Range for all relevant cells

My macro creates a large text file by writing all the data from all sheets in the active workbook.
In each worksheet, it is necessary to determine a certain rectangular range of cells that would be saved in the text file. It's upper left corner would always be A1, but the lower right corner should be chosen so that the range includes all cells with any content (formatting does not matter).
I thought ws.Range("A1").CurrentRegion would do the trick, but it does not work when A1 and the nearby cells are empty. If the only cell with data in the sheet is Q10, then the range should be A1:Q10.
Of course, I could loop over the ws.Cells range to discover the range of interest, but that's quite time consuming, I hope there's more effective way. If I select all cells in a sheet and do a copy-paste to notepad, I do not end up with hundreds of empty columns and thousands of empty rows, only the relevant data are copied. The question is how to replicate that with VBA.
This is my code so far:
Sub CreateTxt()
'This macro copies the contents from all sheets in one text file
'Each sheet contents are prefixed by the sheet name in square brackets
Dim pth As String
Dim fs As Object
Dim rng As Range
pth = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
Dim outputFile As Object
Set outputFile = fs.CreateTextFile(pth & "\Output.txt", True)
Dim WS_Count As Integer
Dim ws As Worksheet
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
outputFile.WriteLine ("[" & ws.Name & "]")
Debug.Print ws.Name
Set rng = ws.Range("A1").CurrentRegion
outputFile.WriteLine (GetTextFromRangeText(rng, vbTab, vbCrLf))
Next I
outputFile.Close
End Sub
Function GetTextFromRangeText(ByVal poRange As Range, colSeparator As String, rowSeparator As String) As String
Dim vRange As Variant
Dim sRow As String
Dim sRet As String
Dim I As Integer
Dim j As Integer
If Not poRange Is Nothing Then
vRange = poRange
Debug.Print TypeName(vRange)
For I = LBound(vRange) To UBound(vRange)
sRow = ""
For j = LBound(vRange, 2) To UBound(vRange, 2)
If j > LBound(vRange, 2) Then
sRow = sRow & colSeparator
End If
sRow = sRow & vRange(I, j)
Next j
If sRet <> "" Then
sRet = sRet & rowSeparator
End If
sRet = sRet & sRow
Next I
End If
GetTextFromRangeText = sRet
End Function
if there is anything in A1:B2 cells, this macro works. It breaks when the A1:B2 is empty and the CurrentRegion property returns Empty.
I think you should use these functions to find the last Row/Column
lastRow = Sheets("Sheetname").Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Sheets("Sheetname").Cells(1, Columns.Count).End(xlToLeft).Column
You specify the name of the sheet and the row/columb-number that you want to find the last cell with information, and it return the number of it.
(In the example the last row in first column, and last column in first row are find)
lastCol will give you an Long as an asnwer. If you want to convert this number into the column letter you can use the next function
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
I hope you find this useful
Thanks to user Rosetta, I've come up with this expression for the sought range:
ws.Range("A1:" & ws.Cells.SpecialCells(xlLastCell).Address)

Resources