Find the first empty cell after a text in a row - vba

I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance

All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub

Related

How to bold line in one cell based on another cell in the same row

I am trying to bold the last line of a multi-line cell (column E), but specifically based on if another cell in the same row (column L) is blank/empty or not. I have working code that bolds just the last line, but trying to incorporate the IF portion has me stuck. This is what I have so far, and it keeps giving me a data mismatch error.
Thanks in advance for any help or advice.
Sub BoldLastLine1()
Dim p As Long
Dim r As Range
For Each r In ActiveSheet.Range("A3:L100")
If Len(Trim(ActiveSheet.Cells(r, 12).Value)) <> 0 Then
p = InStrRev(r.Value, vbLf)
If p > 0 Then
With r.Characters(p + 1, Len(r.Value) - p).Font
.Bold = True
.Size = 16
End With
End If
End If
Next
MsgBox ("Updates Completed.")
End Sub
The cells-property of a worksheet or range expects 2 numeric parameter for row and column.
You are defining a Range r and passing it as first parameter, this causes the error.
You can use for example
If Len(Trim(ActiveSheet.Cells(r.Row, 12).Value)) Then
This points to the cell in column 12 (=L) of the row of range r
UPDATE:
Cells accepts also a string as second parameter, you could also write
If Len(Trim(ActiveSheet.Cells(r.Row, "L").Value)) Then

finding the largest binary number from a range of cells

I have a data of some binary numbers in few range of cells, from A2 to A8, B2 to B8, and so on, till G column.
Now, I want to check the largest binary number from the above Rows and paste it to the cell, two row below the last used range. (i.e., Largest binary number from Row A to be paste in A10, and so on).
I am not finding any function which can find the value of binary numbers, and the code which I ran finds out the max number considering those as natural numbers.
Your help will be appreciated.
Thank You!
Okay first i made a function that converts binary to decimal and stored in a module. (You can store it wherever you want) This function handles any size binary
Function BinToDecConverter(BinaryString As String) As Variant
Dim i As Integer
For i = 0 To Len(BinaryString) - 1
BinToDecConverter = CDec(BinToDecConverter) + Val(Mid(BinaryString, Len(BinaryString) - i, 1)) * 2 ^ i
Next
End Function
Afterwards i made the sub that loops through all binarys on sheet1 (Might need to change this for your sheet)
Sub FindLargestBinary()
On Error Resume Next
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Application.ThisWorkbook
Set ws = wb.Sheets("Sheet1")
Dim tempVal, tempRow As Integer
Dim iCoulmn, iRow As Integer
For iCoulmn = 1 To 7 'Run from A to G
tempRow = 2
tempVal = 0
For iRow = 2 To 8 'Run from row 2 to 8
If BinToDecConverter(ws.Cells(iRow, iCoulmn).Value) > tempVal Then tempVal = BinToDecConverter(ws.Cells(iRow, iCoulmn).Value): tempRow = iRow ' Check if current binary i higher then any previous
Next iRow
ws.Cells(iRow + 1, iCoulmn).Value = ws.Cells(tempRow, iCoulmn).Value 'Print highest binary
Next iCoulmn
End Sub
Hope this helps you out..
You can use the excel function Bin2Dec to change them into decimal
Function MaxBin(r as range)
Dim curmax as long
Dim s as range
For each s in r
If Application.WorksheetFunction.Bin2Dec(s.Text) > curmax Then curmax = Application.WorksheetFunction.Bin2Dec(s.Text)
Next s
MaxBin = curmax
End Function
Assuming your binary values are text strings this formula converts the values to numbers, finds the MAX and then converts back to a text string
=TEXT(MAX(A2:A8+0),"00000")
confirmed with CTRL+SHIFT+ENTER
or you can use this version which finds the max using AGGREGATE function and doesn't require "array entry"
=DEC2BIN(AGGREGATE(14,6,BIN2DEC(A2:A8+0),1))

How do I check whether value in active cell contains any letter or not?

For example cell "A1" is linked to cell "B1", so in formula bar for cell "A1" we have:
=B1
How can I check whether value in cell "A1" contains letter B?
I tried the following:
Dim Criteria_3 As Boolean
Dim Value As Range
Set Value = Selection
Dim x As Variant
Set x = Cells
Dim text As String
For Each x In Value
If IsNumeric(x) Then
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
your question is not really conclusive, so here are two options:
To check wheter the value contains B:
blnCheck = 0 < InStr(1, rngCell.Value, "B")
To check wheter the Formula contains B:
blnCheck = 0 < InStr(1, rngCell.Formula, "B")
Regarding your null string problem:
As soon as value of "Text" is "" it does not work and I really struggle to fined the right solution.
That's because you're using VBA.InStr(1, x.Formula, text) and in this case 1 is an invalid index on a string of length 0. You can omit that, or you can code around it like:
If Len(Trim(x.Formula)) = 0 Then
'## Do nothing
Else
Criteria_3 = VBA.InStr(1, x.Formula, text) > 0
End If
To your specific question of identifying when a value contains any alpha character(s):
You can use a function like this to test whether a value contains any letter, by evaluating the Ascii code for each character, and break when True:
Function ContainsAnyLetter(val) As Boolean
Dim ret As Boolean
Dim str$, ch$
Dim i As Long
str = LCase(CStr(val))
For i = 1 To Len(str)
ch = Mid(str, i, 1)
If 97 <= Asc(ch) And Asc(ch) <= 122 Then
ret = True
Exit For
End If
Next
ContainsAnyLetter = ret
End Function
In your code, you could call it like:
Criteria_3 = ContainsAnyLetter(x.Value) '## or x.Formula, depending on your needs
You can use LIKE
https://msdn.microsoft.com/en-us/library/swf8kaxw.aspx
Something like if rngCell.value like "*B*" then
if your goal is to check whether the cell contains any valid range reference, then you could go like this
Option Explicit
Sub main()
Dim cell As Range
For Each cell In Worksheets("Sheet001").Range("A1:A20") '<== jus a test range, set it as per your needs
MsgBox IsCellReference(cell.Formula)
Next cell
End Sub
Function IsCellReference(text As String) As Boolean
On Error Resume Next
IsCellReference = Not Range(Replace(text, "=", "")) Is Nothing
End Function

Excel range subtraction, overlooking errors in some cells possible?

I am having trouble figuring out how to subtract two ranges from each other, some cells in range H:H have "#N/A" while in range D:D there are no errors. I know in Excel it's a simple "=H2-D2" and drag that down but I'm in the process of recording a Macro and wanted to automate the subtraction as well. So far this is what I have:
Dim quantity1, quantity2, rIntersect, Qdiff, x As Range
Set quantity1 = Range("D:D")
Set quantity2 = Range("H:H")
Set rIntersect = Intersect(quantity1, quantity2)
For Each x In quantity1
If Intersect(rIntersect, x) Is Nothing Then
If Qdiff Is Nothing Then
Set Qdiff = x
Else
Set Qdiff = Application.Union(Qdiff, x)
End If
End If
Next x
Range("J2").Select
Dim lastRowJ As Long
lastRowJ = Range("A" & Rows.Count).End(xlUp).Row
Range("J2").AutoFill Destination:=Range("J2:J" & lastRowJ)
Place this procedure in a standard code module:
Public Sub Subtract()
[j2:j99] = [h2:h99-d2:d99]
End Sub
If you like how that works, I'm happy to embellish it so that it is not hard-coded for 98 rows only. Let me know.
UPDATE
Here is a version that will deal with any number of rows. It keys off of column D. So if there are 567 numbers in column D, then you will get 567 corresponding (subtracted) results in column J.
This assumes that the data start in row 2, and that there are no blank cells until the numbers in column D end.
If you are going to call this from the Macro Dialog then you should keep it Public. If on the other hand you are going to call it from another procedure in the same module, then you can make it Private.
Here is the enhanced solution:
Public Sub Subtract()
Dim k&
Const F = "iferror(h2:h[]-d2:d[],0)"
k = [count(d:d)]
[j2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub
Note that the routine now handles the errors and places a ZERO value in column J when the corresponding value in column H is an error. If you would prefer to have something other than a ZERO (like a blank for instance) when there are errors in column H, just let me know and I'll update to whatever you want.
UPDATE 2
Here is how to handle displaying blanks instead of zeroes:
Public Sub Subtract()
Dim k&
Const F = "iferror(if(h2:h[]-d2:d[]=0,"""",h2:h[]-d2:d[]),0)"
k = [count(d:d)]
[k2].Resize(k) = Evaluate(Replace(F, "[]", k + 1))
End Sub

Finding The Last Row With Text using a Do Loop

Please Excuse My Inexperience,
I'm to write a function that returns the last row that returns a non empty string in collumn 1 using a do loop.
If there is no empty rows, you could simply go with something like this :
Public Sub MySub()
Dim wsTarget As Worksheet
Set wsTarget = ActiveSheet
Dim n As Integer
n = 1
Do While (wsTarget.Cells(n +1, 1).Value <> "")
n = n + 1
Loop
n = n - 1
'n now contains the line number of the last non-empty row.
End Sub
Edit : For this example, I suppose you're looking into the first column, and that the data starts on line 2. If there is no rows with data, n will be worth 1.