I'm trying to write something up that will search a specific range for specific numbers.
EX:
Dim cell As Range
For Each cell In Range("E5:E112")
If InStr(cell.Value, "260") > 0 Then
DO THIS
ElseIf InStr(cell.Value, "154") > 0 Then
DO THIS
etc...
I used instr since the cell will have things like "word 1 word 2 260 word 3."
For every match it finds within that range, I want to put a certain value into the same row in a different column.
Suggestions? Thanks in advance!
Try This:
Sub testing()
Dim cell As Range
For Each cell In Range("E5:E112")
If InStr(cell.Value, "260") > 0 Then
cell.Offset(0, 2).Value = "Found 260"
ElseIf InStr(cell.Value, "154") > 0 Then
cell.Offset(0, 2).Value = "Found 154"
End If
Next
End Sub
create an array of the items you want to look up then loop that with a built in lookup function.
Then use the row number returned to find the value you want. It will be quicker
Dim lkupArr()
lkupArr = Array(260, 154)
Dim i As Long
For i = LBound(lkupArr) To UBound(lkupArr)
Dim lkuprow As Long
lkuprow = 0
On Error Resume Next
lkuprow = Application.WorksheetFunction.Match("*" & lkupArr(i) & "*", ActiveSheet.Range("E:E"), 0)
On Error GoTo 0
If lkuprow > 0 Then
MsgBox lkupArr(i) & " found on row " & lkuprow & "."
'Then just use the return to return the value from the column you want
'The following returns the value in column F on the same row.
Dim ret
ret = ActiveSheet.Cells(lkuprow, "F").Value
Debug.Print ret
End If
Next i
Maybe not the most elegant solution, however does not make extensive use of the spreadsheet, so performance wise (if you have a lot of data to process), should be better than other solutions so far.
Function SearchAndFind()
Dim wb As Workbook
Dim ws As Worksheet
Dim rngValues As Range
Dim arrRng As Variant, arrFind As Variant
Dim i As Long, j As Long, newColOffset As Long
'Adjust as needed
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Set rngValues = ws.Range("E5:E112")
arrRng = rngValues
arrFind = Array("260", "154")
newColOffset = 2
For i = LBound(arrRng) To UBound(arrRng) 'loop through the given range, first column only
For j = LBound(arrFind) To UBound(arrFind) 'loop through items to find
If InStr(arrRng(i, 1), arrFind(j)) > 0 Then 'found the value
'Return the values
rngValues.Cells(1, 1).Offset(i - 1, newColOffset).Value = arrRng(i, 1)
Exit For
End If
Next j
Next i
End Function
Related
I have if function that should check a few conditions in excel tab and if column B <> 0 and column C has "A" then it gives me "OK"
But it is not working. I tried to add .text, .value or whatever, still it doesnot see "A" in and gives me "Run-time error 424 Object required"
Could you please advise?
Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim iRow1 As Long
Dim iCol1 As Long
Dim jRow As Long
Dim jCol As Long
Dim i As Long
strRangeToCheck = "A1:V1000"
' If you know the data will only be in a smaller range, reduce the size of the ranges above.
Debug.Print Now
varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet2").Range(strRangeToCheck) ' or whatever your other sheet is.
Debug.Print Now
For iRow1 = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol1 = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetB(iRow1, 2) <> 0 And varSheetB(iRow1, 3)="A" Then
MsgBox ("OK")
'Sheets("Sheet2").Select
'Cells(iRow1, iCol1).EntireRow.Copy
'Sheets("Sheet4").Select
'Range("A" & Rows.Count).End(xlUp).Offset(1).Select
'ActiveSheet.Paste
End If
Next iCol1
Next iRow1
MsgBox ("Done")
End Sub
Your code is hard to follow, but your description says you want to look in column C for the letter A and if found check if the value in column B is not 0.
I'm pretty sure you don't want to display 'OK' everytime a value is matched - that could be 1000 oks to ok, which is not ok (unless you're building some kind of torture program).
This code will return a single message box listing the row numbers that matched the criteria. No doubt you'll want to change the code to do something a bit more useful though.
Public Sub Test()
Dim SearchRange As Range
Dim FoundValue As Range
Dim FirstAddress As String
Dim Message As String
'Only going to search column C for the letter A.
Set SearchRange = ThisWorkbook.Worksheets("Sheet1").Range("C1:C1000")
With SearchRange
'Find the first value if it exists.
Set FoundValue = .Find("A", LookIn:=xlValues, LookAt:=xlWhole)
'Only continue if something was found.
If Not FoundValue Is Nothing Then
FirstAddress = FoundValue.Address
Do
'Record the row number if the value in column B is not 0.
If FoundValue.Offset(, -1) <> 0 Then
'Copy the row to Sheet2.
'Column C will have a value in each row (it will contain the letter A)
'so that can be used to find the next available row to copy to.
With ThisWorkbook.Worksheets("Sheet2")
FoundValue.EntireRow.Copy Destination:= _
.Cells(.Rows.Count, 3).End(xlUp).Offset(1, -2)
End With
Message = Message & FoundValue.Row & vbCrLf
End If
'Look for the next letter A.
Set FoundValue = .FindNext(FoundValue)
Loop While FoundValue.Address <> FirstAddress
End If
End With
MsgBox "Criteria met on these rows:" & vbCrLf & Message, vbOKOnly + vbInformation
End Sub
I am having a macro that checks the matching values from column A and row 2 in sheet2. Based on each value in the range B3 to C6 (dynamic field may get changed (there is maximum 7 location and below that 5 roles, may appears here ) in sheet1.
Problem with my code is that my loop "j" is not working as expected... It will result in executing the code 8 to 16 times in per below scenario (where I am expected it to run only 4 times)
Sub GetRowNum()
Dim rLoc
Dim rRol
Dim LocSrch1
Dim RolSrch1
Dim disRangeLoc As Range
Dim disRangeRol As Range
Dim i
Dim j
Dim shtA As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lInter As Variant
Dim Table As Range
Set shtA = Sheets ("Sheet1") 'storing the sheets...
Set shtB = Sheets ("Sheet2")
shtA.Activate
rLoc = shtA.Range("B2").End(xlDown).Row
rRol = shtA.Range("C2").End(xlDown).Row 'the last row of the list
LocSrch1 = 2 'column A... changed if you need
Set disRangeLoc = Range(Cells(3, LocSrch1), Cells(rLoc, LocSrch1)) 'here need to change the 2 for
'1 if you do not want headers
RolSrch1 = 3 'column A... changed if you need
Set disRangeRol = Range(Cells(3, RolSrch1), Cells(rRol, RolSrch1))
For Each i In disRangeLoc 'for each item inside the list of prod going to discount
For Each j In disRangeRol
MsgBox i
MsgBox j
shtB.Activate
Set Table = shtB.Range("A1:H7")
On Error Resume Next
lRow = shtB.Application.WorksheetFunction.Match(j, Range("A:A"), 0)
On Error GoTo 0
If lRow > 0 Then
End If
On Error Resume Next
lCol = shtB.Application.WorksheetFunction.Match(i, Range("2:2"), 0)
On Error GoTo 0
If lRow > 0 Then
End If
On Error Resume Next
lInter = Application.WorksheetFunction(lCol, lRow).Value
On Error GoTo 0
If lRow > 0 Then
MsgBox Table.Cells(lRow, lCol).Value
End If
On Error GoTo 0
Next j
Next i
End Sub
My final target is to find the revenue under D7 as shown in image1 (sheet1) and this code is 1st step towards it... If someone had a better suggestion to calculate in such a simple way, kindly guide me.
Someone, please help me to correct my code... And I hope u understand my requirement... Else please ask, I will try to explain better
Thanks in advance
If you set For Each j In disRangeRol then it will take each value in the range you already defined. if you keep Set J = I.Offset(0, 1) then it will consider and check the value in 'i' if true it will take the value just right to it and won't go for Each values in disRangeRol, Try below code
Sub GetRowNum() 'find the value from Sheet2 if Location and Role matches
Dim rLoc
Dim rRol
Dim LocSrch1
Dim RolSrch1
Dim disRangeLoc As Range
Dim disRangeRol As Range
Dim I
Dim J
Dim shtA As Worksheet
Dim shtB As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lInter As Variant
Dim Table As Range
Set shtA = Sheets("Sheet1")
Set shtB = Sheets("Sheet2")
shtA.Activate
rLoc = shtA.Range("B2").End(xlDown).row
rRol = shtA.Range("C2").End(xlDown).row 'the last row of the list
'with the discounted prods
'If you do not want headers,
'use A1 here
LocSrch1 = 2 'column B... changed if you need
Set disRangeLoc = Range(Cells(3, LocSrch1), Cells(rLoc, LocSrch1)) 'here need to change the 2 for
'1 if you do not want headers
RolSrch1 = 3 'column A... changed if you need
Set disRangeRol = Range(Cells(3, RolSrch1), Cells(rRol, RolSrch1))
For Each I In disRangeLoc 'for each item inside the list of prod going to discount
Set J = I.Offset(0, 1) 'it will check the value in i if yes it will take the value just right to it
shtB.Activate
Set Table = shtB.Range("A1:H7")
On Error Resume Next
lRow = shtB.Application.WorksheetFunction.Match(J, Range("A:A"), 0)
On Error GoTo 0
If lRow > 0 Then
End If
On Error Resume Next
lCol = shtB.Application.WorksheetFunction.Match(I, Range("2:2"), 0)
On Error GoTo 0
If lRow > 0 Then
End If
On Error Resume Next
lInter = Application.WorksheetFunction(lCol, lRow).Value
On Error GoTo 0
If lRow > 0 Then
'MsgBox I
'MsgBox J
MsgBox Table.Cells(lRow, lCol).Value
RevValue = Table.Cells(lRow, lCol).Value 'it will set the values each time the loop run
End If
On Error GoTo 0
shtA.Activate ' help to make sure you feed the date in right sheet, else data will get feed to Sheet2
ActiveCell.Value = RevValue & "," & ActiveCell.Value 'this will feed the date into the field using a comma separation
Next I
shtA.Activate
End Sub
Updated the code to feed the data into specific column as well
Here I got problem return 1010 logical test. It should checking each cell in range, and exit loop if cell contain number. Return 1 if any cell in range contain value, return 0 if all cell is blank. I tried worksheet function CountIf, CountA, Not IsEmpty, IsText but result is different seems like the blank cell contain invisible string. IsNumeric works on single cell but when range included its not working. I also note the first time I got it run, it produce result, second run causing error. Please help, my range need to be in variable term.
Sub Try()
Dim path As String, myfile As String, file As String
Dim wb As Workbook
Dim i As Integer
Dim NCell As Range
Dim IsNumber As Boolean
path = "E:\SouthNorth\"
myfile = path & "1979.xls"
file = Dir(myfile)
Set wb = Workbooks.Open(Filename:=path & file)
wb.Activate 'necessary?
i = 24
'here object defined error
For Each NCell In Worksheets("Sheet1").Range(Cells(i, 2), Cells(i, 4))
If IsNumeric(NCell) Then
IsNumber = True
If IsNumber = True Then Exit For
End If
Next NCell
Select Case IsNumber
Case True
wb.Worksheets("Sheet2").Range("B" & i) = 1
Case False
wb.Worksheets("Sheet2").Range("B" & i) = 0
End Select
End Sub
I think this belongs in a comment but I'm not allowed to...
You mentioned that your problem is when you try running it a second
time, which means that the error could be from vba trying to open
your file when it is already open. Everything else seems to work
Ignore all this, it was my original "answer" but I don't know how to format a strikethough and I don't want to delete it all.
Try this code
Sub Try()
Dim wb As Workbook
Dim path As String
Dim i As Integer, j As Integer
Dim NCell As Range
path = "E:\SouthNorth\1979.xls"
Set wb = Workbooks.Open(Filename:=path)
wb.Activate
i = 24
Sheets("Sheet2").Range("B" & i).Value = 0
For j = 2 To 4
Set NCell = Sheets("Sheet1").Cells(i, j)
If IsNumeric(NCell.Value) Then
Sheets("Sheet2").Range("B" & i).Value = 1
Exit For
End If
Next j
End Sub
You can use 'CountBlank' - if the column range is always 3 cells then you can declare a boolean and subtract the blank count from 3, giving you a 0 (false) if all cells are blank or anything above 0 (true) if at least one cell is occupied:
Dim x As Boolean
x = 3 - Application.WorksheetFunction.CountBlank(Worksheets("Sheet1").Range(Cells(i, 2), Cells(i, 4)))
MsgBox x
If it's specific to numerical values (e.g. ignoring text) then just add to your IsNumeric line:
If IsNumeric(ncell) And Not ncell = "" Then
To start off with, it is a really bad practice to leave the Cells defining a Range object without a parent worksheet. See Is the . in .Range necessary when defined by .Cells? for more information.
Worksheets("Sheet1").Range(Cells(24, 2), Cells(24, 4))
You seem to specifically want a count for numbers. Bringing in the worksheet's COUNT function will do this.
With Worksheets("Sheet1")
With .Range(.Cells(24, 2), .Cells(24, 4))
Worksheets("Sheet2").Range("B" & i) = Abs(CBool(Application.Count(.Cells)))
End With
End With
You can also stay strictly within VBA with SpecialCells using xlCellTypeConstants with xlNumbers.
Dim rng As Range
With Worksheets("Sheet1")
On Error Resume Next
Set rng = .Range(.Cells(24, 2), .Cells(24, 4)).SpecialCells(xlCellTypeConstants, xlNumbers)
On Error GoTo 0
If Not rng Is Nothing Then
Worksheets("Sheet2").Range("B" & i) = 1
Else
Worksheets("Sheet2").Range("B" & i) = 0
End If
End With
How to find location of last cell from defined Range? Cell does not have to contain any data but must be most right and most down located cell from certain Range.
Set rngOrigin = wksOrigin.Cells(IntFirstRow, IntFirstColumn).CurrentRegion
I wish to receive
Cells(i,j)
Perhaps this is what you want:
Dim rngLastCell As Range
Set rngLastCell = rngOrigin(rngOrigin.Count)
maybe you're after this:
'absolute indexes from cell A1
With rngOrigin
i = .Rows(.Rows.count).row
j = .Columns(.Columns.count).Column
End With
'relative indexes from rngOrigin upleftmost cell
With rngOrigin
i = .Rows(.Rows.count).row - .Rows(1).row + 1
j = .Columns(.Columns.count).Column - .Columns(1).Column + 1
End With
I handled it in below code but your remarks were helpful. Thank you.
intLastRow = rngOrigin.Cells(1, 1).Row + rngOrigin.Rows.Count - 1
intLastCol = rngOrigin.Cells(1, 1).Column + rngOrigin.Columns.Count - 1
The answers given by others mostly work, but not if the region is a union of non-contiguous cells. Here is a version that works consistently for single and multi-area regions, contiguous and non-contiguous.
Function LastCellOfRange(rng As Excel.Range) As Excel.Range
Dim area As Excel.Range
Dim rowNum As Long
Dim maxRow As Long
Dim colNum As Long
Dim maxCol As Long
Dim areaIdx As Integer
Set LastCellOfRange = Nothing
maxRow = 0
maxCol = 0
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx)
rowNum = area.Cells(area.Cells.Count).row
If (rowNum > maxRow) Then
maxRow = rowNum
End If
colNum = area.Cells(area.Cells.Count).Column
If (colNum > maxCol) Then
maxCol = colNum
End If
Next areaIdx
Set LastCellOfRange = rng.Worksheet.Cells(maxRow, maxCol)
Set area = Nothing
End Function
Use this to code find the last cell in a given range
Sub GetLastCellFromRange()
Dim rng As Range
Set rng = Range("$C$10:$E$20")
'Set rng = Range(Selection.Address) ' Use this line to select the range in worksheet
MsgBox "Last Cell of given range is : " & rng.Cells(rng.Rows.Count, rng.Columns.Count).Address
End Sub
I hope it will help you
you could try the following but it relies upon cells always being populated
rngOrigin.End(xlDown).End(xlRight)
or you could use the CurrentRegion and count the rows and columns and use Offset
Alternatively, you could use this construct which works even with ranges based on entire rows or entire columns.
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6")
Dim rngLast As Excel.Range
Set rngLast = rngOrigin.Cells(rngOrigin.Cells.Count)
Debug.Print rngLast.Address
End Sub
Finally, for ranges with multiple areas you'll have to script against a range's Areas collection ...
Sub Test()
Dim rngOrigin As Excel.Range
Set rngOrigin = Range("$A$1:$D$6,$F$1:$G$6")
Debug.Print rngOrigin.Areas(1).Cells(rngOrigin.Areas(1).Cells.Count).Address
Debug.Print rngOrigin.Areas(2).Cells(rngOrigin.Areas(2).Cells.Count).Address
End Sub
Many answers here will work as long as the given range is continuous. This is what I would use for a range that you are absolutely sure is going to be continuous:
Sub test()
Dim myRng As Range, lastCell As Range
Set myRng = Range("A1:D4")
Set lastCell = myRng.Cells(myRng.Rows.Count, myRng.Columns.Count)
Debug.Print lastCell.Address 'returns $D$4
End Sub
For non-continuous, DB user10082797 gave a great solution, however their function fails when the ranges are positioned diagonal-up (for example, if you pass rng=A3:B4,C1:D2 in you will get D4 as the output which was not part of the original range.)
So the question becomes, what is the last cell in the range A3:B4,C1:D2? Is it B4 or D2? That's a decision for the programmer. Here is a function I wrote with the help of DB user10082797's function:
Function LastCellOfRange(rng As Range, Optional returnLastRow As Boolean = True) As Range
'returns the last cell in #rng.
'if #returnLastRow is TRUE, then the output will always be in the right most cell of the last row of #rng
'if #returnLastRow is FALSE, then the output will always be in the bottom most cell of the last column of #rng
'(#returnLastRow only matters for non-contiguous ranges under certain circumstances.)
'initialize variables
Dim area As Range, areaIdx As Long
Dim lastCellInArea As Range
'loop thru each area in the selection
For areaIdx = 1 To rng.Areas.Count
Set area = rng.Areas(areaIdx) 'get next area
Set lastCellInArea = area.Cells(area.Rows.Count, area.Columns.Count) 'get the last cell in the area
'if:
' the return is empty
' OR if the last row needs to be returned and this row is larger than the last area's
' OR if the last row needs to be returned and this row is the same as the last area's but has a larger column
' OR if the last column needs to be returned and this column is larger than the last area's
' OR if the last column needs to be returned and this column is the same as the last area's but has a larger row
'THEN:
' make this cell the return range
If LastCellOfRange Is Nothing Then
Set LastCellOfRange = lastCellInArea '(must be seperate from the other statment when its not set to anything)
ElseIf _
returnLastRow = True And lastCellInArea.Row > LastCellOfRange.Row _
Or returnLastRow = True And lastCellInArea.Row = LastCellOfRange.Row And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column > LastCellOfRange.Column _
Or returnLastRow = False And lastCellInArea.Column = LastCellOfRange.Column And lastCellInArea.Row > LastCellOfRange.Row _
Then
Set LastCellOfRange = lastCellInArea
End If
Next areaIdx
End Function
You can use the function like this:
Sub test()
Dim myRng As Range
Set myRng = Range("A3:B4,C1:D2")
Debug.Print LastCellOfRange(myRng).Address 'returns $B$4
Debug.Print LastCellOfRange(myRng, False).Address 'returns $D$2
End Sub
In your case, since you want to find the cell to the most right and down in your wksOrigin (defined as Worksheet), you could use the SpecialCells(xlCellTypeLastCell) to get the last cell Row and Column.
i = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Row ' <-- get last row number
j = wksOrigin.Cells.SpecialCells(xlCellTypeLastCell).Column ' <-- get last column number
If you want to debug your result, you can add:
MsgBox "Last row at " & i & ", last column at " & j
If you want the absolute last cell of a defined range, regardless of whether it has any content, here is a simple solution
Dim InputRng As Range 'define a range for the test'
Set InputRng = Range("$F$3:$F$15")
MsgBox InputRng(1).Address & ":" & InputRng(InputRng.Cells.Count).Address 'This would output the absolute address of defined range'
I need to find the first blank row in a workbook and write information to (row, 1) and (row, 2). I think I'm currently pretty stuck...
Function WriteToMaster(num, path) As Boolean
'Declare variables
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim infoLoc As Integer
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("PATH OF THE DOC")
Set ws = wb.Worksheets("Sheet1")
'Loop through cells, looking for an empty one, and set that to the Num
Cells(1, 1).Select
For Each Cell In ws.UsedRange.Cells
If Cell.Value = "" Then Cell = Num
MsgBox "Checking cell " & Cell & " for value."
Next
'Save, close, and quit
wb.Save
wb.Close
xlApp.Quit
'Resets the variables
Set ws = Nothing
Set wb = Nothing
Set xlApp = Nothing
Thanks so much for any help.
If you mean the row number after the last row that is used, you can find it with this:
Dim unusedRow As Long
unusedRow = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
If you mean a row that happens to be blank with data after it... it gets more complicated.
Here's a function I wrote which will give you the actual row number of the first row that is blank for the provided worksheet.
Function firstBlankRow(ws As Worksheet) As Long
'returns the row # of the row after the last used row
'Or the first row with no data in it
Dim rw As Range
For Each rw In ws.UsedRange.Rows
If rw.Address = ws.Range(rw.Address).SpecialCells(xlCellTypeBlanks). _
Address Then
firstBlankRow = rw.Row
Exit For
End If
Next
If firstBlankRow = 0 Then
firstBlankRow = ws.Cells.SpecialCells(xlCellTypeLastCell). _
Offset(1, 0).Row
End If
End Function
Usage example: firstblankRow(thisworkbook.Sheets(1)) or pass any worksheet.
Edit: As ooo pointed out, this will error if there are no blank cells in your used range.
I would have done it like this. Short and sweet :)
Sub test()
Dim rngToSearch As Range
Dim FirstBlankCell As Range
Dim firstEmptyRow As Long
Set rngToSearch = Sheet1.Range("A:A")
'Check first cell isn't empty
If IsEmpty(rngToSearch.Cells(1, 1)) Then
firstEmptyRow = rngToSearch.Cells(1, 1).Row
Else
Set FirstBlankCell = rngToSearch.FindNext(After:=rngToSearch.Cells(1, 1))
If Not FirstBlankCell Is Nothing Then
firstEmptyRow = FirstBlankCell.Row
Else
'no empty cell in range searched
End If
End If
End Sub
Updated to check if first row is empty.
Edit: Update to include check if entire row is empty
Option Explicit
Sub test()
Dim rngToSearch As Range
Dim firstblankrownumber As Long
Set rngToSearch = Sheet1.Range("A1:C200")
firstblankrownumber = FirstBlankRow(rngToSearch)
Debug.Print firstblankrownumber
End Sub
Function FirstBlankRow(ByVal rngToSearch As Range, Optional activeCell As Range) As Long
Dim FirstBlankCell As Range
If activeCell Is Nothing Then Set activeCell = rngToSearch.Cells(1, 1)
'Check first cell isn't empty
If WorksheetFunction.CountA(rngToSearch.Cells(1, 1).EntireRow) = 0 Then
FirstBlankRow = rngToSearch.Cells(1, 1).Row
Else
Set FirstBlankCell = rngToSearch.FindNext(After:=activeCell)
If Not FirstBlankCell Is Nothing Then
If WorksheetFunction.CountA(FirstBlankCell.EntireRow) = 0 Then
FirstBlankRow = FirstBlankCell.Row
Else
Set activeCell = FirstBlankCell
FirstBlankRow = FirstBlankRow(rngToSearch, activeCell)
End If
Else
'no empty cell in range searched
End If
End If
End Function
Update
Inspired by Daniel's code above and the fact that this is WAY! more interesting to me now then the actual work I have to do, i created a hopefully full-proof function to find the first blank row in a sheet. Improvements welcome! Otherwise, this is going to my library :)
Hopefully others benefit as well.
Function firstBlankRow(ws As Worksheet) As Long
'returns the row # of the row after the last used row
'Or the first row with no data in it
Dim rngSearch As Range, cel As Range
With ws
Set rngSearch = .UsedRange.Columns(1).Find("") '-> does blank exist in the first column of usedRange
If Not rngSearch Is Nothing Then
Set rngSearch = .UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks)
For Each cel In rngSearch
If Application.WorksheetFunction.CountA(cel.EntireRow) = 0 Then
firstBlankRow = cel.Row
Exit For
End If
Next
Else '-> no blanks in first column of used range
If Application.WorksheetFunction.CountA(Cells(.Rows.Count, 1).EntireRow) = 0 Then '-> is the last row of the sheet blank?
'-> yeap!, then no blank rows!
MsgBox "Whoa! All rows in sheet are used. No blank rows exist!"
Else
'-> okay, blank row exists
firstBlankRow = .UsedRange.SpecialCells(xlCellTypeBlanks).Row + 1
End If
End If
End With
End Function
Original Answer
To find the first blank in a sheet, replace this part of your code:
Cells(1, 1).Select
For Each Cell In ws.UsedRange.Cells
If Cell.Value = "" Then Cell = Num
MsgBox "Checking cell " & Cell & " for value."
Next
With this code:
With ws
Dim rngBlanks As Range, cel As Range
Set rngBlanks = Intersect(.UsedRange, .Columns(1)).Find("")
If Not rngBlanks Is Nothing Then '-> make sure blank cell exists in first column of usedrange
'-> find all blank rows in column A within the used range
Set rngBlanks = Intersect(.UsedRange, .Columns(1)).SpecialCells(xlCellTypeBlanks)
For Each cel In rngBlanks '-> loop through blanks in column A
'-> do a countA on the entire row, if it's 0, there is nothing in the row
If Application.WorksheetFunction.CountA(cel.EntireRow) = 0 Then
num = cel.Row
Exit For
End If
Next
Else
num = usedRange.SpecialCells(xlCellTypeLastCell).Offset(1).Row
End If
End With
I know this is an older thread however I needed to write a function that returned the first blank row WITHIN a range. All of the code I found online actually searches the entire row (even the cells outside of the range) for a blank row. Data in ranges outside the search range was triggering a used row. This seemed to me to be a simple solution:
Function FirstBlankRow(ByVal rngToSearch As Range) As Long
Dim R As Range
Dim C As Range
Dim RowIsBlank As Boolean
For Each R In rngToSearch.Rows
RowIsBlank = True
For Each C In R.Cells
If IsEmpty(C.Value) = False Then RowIsBlank = False
Next C
If RowIsBlank Then
FirstBlankRow = R.Row
Exit For
End If
Next R
End Function
ActiveSheet.Range("A10000").End(xlup).offset(1,0).Select
very old thread but .. i was lookin for an "easier"... a smaller code
i honestly dont understand any of the answers above :D
- i´m a noob
but this should do the job. (for smaller sheets)
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
reads every cell in col 1 from bottom up and stops at first empty cell
intRow = 1
Do until objExcel.Cells(intRow, 1).Value = ""
intRow = intRow + 1
Loop
then you can write your info like this
objExcel.Cells(intRow, 1).Value = "first emtpy row, col 1"
objExcel.Cells(intRow, 2).Value = "first emtpy row, col 2"
etc...
and then i recognize its an vba thread ... lol
Very old thread but a simpler take :)
Sub firstBlank(c) 'as letter
MsgBox (c & Split(Range(c & ":" & c).Find("", LookIn:=xlValues).address, "$")(2))
End Sub
Sub firstBlank(c) 'as number
cLet = Split(Cells(1, c).address, "$")(1)
MsgBox (cLet & Split(Range(cLet & ":" & cLet).Find("", LookIn:=xlValues).address, "$")(2))
End Sub
Function firstBlankRow() As Long
Dim emptyCells As Boolean
For Each rowinC In Sheet7.Range("A" & currentEmptyRow & ":A5000") ' (row,col)
If rowinC.Value = "" Then
currentEmptyRow = rowinC.row
'firstBlankRow = rowinC.row 'define class variable to simplify computing complexity for other functions i.e. no need to call function again
Exit Function
End If
Next
End Function