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

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

Related

Finding dates and storing ranges in variables

I'm trying to find "blocks" in the worksheet that have dates in the A-column. A block is seperated by lines as you can see from the picture. The whole file is full of these blocks but I only need the blocks that have dates in the A-column. Just to be clear I don't just need the rows with the dates but the full block that contains the date.
A block in my files for example is the Range A172:G192.
Picture of the file:
[![enter image description here][1]][1]
How should I continue after selecting the first block? I probably should use the Find function starting from row 184 or the row of ResultDown variable moving down the sheet on "A" Column. However the row needs to be dynamic, so I can use it for the next block. Also I have no idea how many blocks there will be, so I would like to hear from you how to solve this aswell.
I would like to save all the blocks as different variables and then hide all the blocks in the worksheet and then just unhide the blocks that I stored in the variables.
My biggest problem is the last row.
Result2 = Range(Cells(StartcellRow, 1), Cells(1000, 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow, 1))).Select
I keep getting an runtime error 1004
Public Sub FB_MAKRO()
Dim FBwb As Workbook
Dim FBsht As Worksheet
Dim ACol As Range
'Set variables for workbook and sheet
Set FBwb = Workbooks.Open(Filename:="C:\Users\l000xxx\Desktop\Makrot\FORCED BALANCE MAKRO\FB HARJOITUS.xls")
Set FBsht = FBwb.Sheets("Forced Balance")
Set ACol = FBsht.Range("A1:A1000")
'I want ACol variable to be the entire A-Column. Any ideas?
'For some reason the range function is not working here?
'This locates the date in A'column, so I can select the correct block
Result = Range("A3:A1000").Find(What:="**/**/****", After:=Range("A3")).Address
'This is the top left corner of the Block1 selection
ResultUp = Range(Result).End(xlUp).Offset(-1, 0).Address
Range(ResultUp).End(xlDown).Select
Range(ActiveCell, ActiveCell).End(xlDown).Select
'The ResultsDownLastRow variable is for Block2 find function
'ResultDown is the bottom right corner of the Block1
ResultsDownLastRow = Range(ActiveCell, ActiveCell).End(xlDown).Address
ResultDown = Range(ActiveCell, ActiveCell).End(xlDown).Offset(-2, 6).Address
'First Block assigned. I plan to use this in the end when I hide everything and then unhide these blocks
Block1 = Range(ResultUp, ResultDown).Select
' NEXT BLOCK STARTS HERE
'StartCellRow is the cell that the find function should start looking for Block2
'Result2 is the find function for Block2
StartcellRow = Range(ResultsDownLastRow).Row
Result2 = Range(Cells(StartcellRow, 1), Cells(1000, 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow, 1))).Select
End Sub
'This returns value 194
StartcellRow = Range(ResultsDownLastRow).Row MsgBox StartcellRow
'This should work but doesn't. I get a syntax error
Range(Cells(StartcellRow &","& 1),Cells(1000 & "," & 1)).Find(What:="**/**/****", After:=Range(Cells(StartcellRow& ","& 1)).Select
This doesn't work either
'StarcellRow gives out value of 194
StartcellRow = Range(ResultsDownLastRow).Row
Result2 = Range("A&:StartcellRow:A648").Find(What:="**/**/****", After:=Range("A&:StartcellRow")).Select
This doesn't give me a syntax error but it's not working
I would search for all currency header and store their rownumber into an array. For each rownumber in the array i would look into the cell below (rownumber + 1). when there is a date in the cell, i would set the range in the following way:
set rangeWithDate = Range(Cells(actualRowNumberInArray - 1, 1), Cells(nextRowNumberInArray - 2, 7))
Array:
Dim array1() As long
Redim array1(5)
For i = 1 To 5
array(i) = i
Next i
Redim array1(10) ' changes the "length" of the array, but deletes old entries
For i = 1 To 10
Feld1(i) = i
Next i
Redim Preserve array1(15) ' changes the "length" of the array without deleting old entries

Find the first empty cell after a text in a row

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

How can I refer to a data in a different row?

I've got an Excel file with N rows and M columns. Usually data are organized one per row, but it can happens that a data occupy more than a row. In this case how can I express that the second (or next) row has to refer to the first row?
In this example, AP.01 has got 5 rows of description, so how can I say that the other 4 rows refer also to the first code?
EDIT once that I did the association I have to export my Excel file into an Access DB. So I want to see the tables with the correct data.
If I have only one row for the description I wrote this code and it works:
If grid(r, 3).Text.Length > 255 Then
code.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
code.Description = grid(r, 3).Text.ToString
End If
Instead if I have more than one row for the description I wrote this code and it doesn't work:
Do While grid(r, 1).ToString = ""
If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then
Dim s As String
s = grid(r, 3).ToString
code.Description = grid((r - 1), 3).ToString & s
End If
Loop
If it is a one-off, try the below. This will basically put a formula in every cell that refers to the cell immediately above it:
Select column A (from top until bottom of list (row N)
Press ctrl + g to open the GoTo dialogue
Press Special
Select Blanks from the radio buttons
The above will select all the blank cells in column A. Now enter = and press up arrow. Enter the formula by holding down ctrl while pressing enter. That will enter the same formula in every cell.
Try
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet3") 'change Sheet3 to your data sheet
With .Range("A:A").SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
From your question I Guess that, you must be define a variable for last column Value. and check the value in respective column, if it is empty then use column value if not empty then take current value as last value.
'Dim LastValue as string
LastValue = sheet("SheetName").cells(i,"Column Name").value
for i = 2 to LastRow '>>>> here i am assume you run code in for loop from row to
'to last count row(LastRow as variable)
'Put your sheet name at "SheetName" and column index (like "A","B","C"...) at "Column Name"
if sheet("SheetName").cells(i,"Column Name").value <>"" then
LastValue = sheet("SheetName").cells(i,"Column Name").value
end if
'(Do your stuff using LastValue , you may generate lastvalue 1, lastvalue2 ..etc)
next'for loop end here

Delete entire row when a value exist (With sheets) [duplicate]

I have 2 sheets: sheet1 and sheet2. I have a value in cell A3 (sheet1) which is not constant. And many files in sheets2.
What I would like to do, is when the value in cell A3 (Sheet1) is the same as the value in the column A (Sheet2), it will delete the entire row where is find this value (Sheet2).
This is my attempt. It doesn't work: no rows are deleted.
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
Dim f As String
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(f)
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
End If
My guess is that you're not finding anything with the .Find(). Since you're not checking it for is Nothing you don't know. Also, .Find() retains all the search parameters set from the last time you did a search - either via code or by hand in your spreadsheet. While only the What parameter is required, it's always worth setting the most critical parameters (noted below) for it, you may want to set them all to ensure you know exactly how you're searching.
Dim f As String
If Worksheets("Sheet1").Range("A3").Text = Worksheets("Sheet2").Range("A:A").Text Then
f = Worksheets("Sheet1").Range("A3")
Set c = Worksheets("Sheet2").Range("A:A").Find(What:=f, Match:=[Part|Whole], _
LookIn:=[Formula|value])
if not c is Nothing then
Worksheets("Sheet2").Range(c.Address()).EntireRow.Delete
else
MsgBox("Nothing found")
End If
End If
Go look at the MS docs to see what all the parameters and their enumerations are.
Sub Test()
Dim ws As Worksheet
For x = 1 To Rows.Count
If ThisWorkbook.Sheets("Sheet2").Cells(x, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(3, 1).Value Then ThisWorkbook.Sheets("Sheet2").Cells(x, 1).EntireRow.Delete
Next x
End Sub

VBA Excel: How to check if a value is in a selected range of values (or current cell)

I have a reference set of data in a column of cells (it could have been a row, but whatever).
I want to go through several worksheets, checking a selected range of values and if the current cell value is in the reference data, use it as the value to paste into an Offset of the next series of cells until the current cell has changed to some new value in the reference data, at which time the paste process should repeat for the new value and next series of cells.
e.g.
Sub doStuff()
Dim RefRange As Range, queryRange As Range, checkCell As Rnage
String pasteDate As String
Set RefRange = Range("A1:A50")
Set queryRange = .Selected
For Each checkCell In queryRange
If checkCell.Value IN RefRange <***here's where I don't know what to use ***>
pasteData = checkCell.Value
' Advance to next item
Next
ElseIf checkCell.Value Not In queryRange <***here's where I don't know what to use ***>
ActiveCell.Offset(0,+1).Value = pasteData
End If
Next
End Sub
I know how to do this in SQL, is there some similar method in VBA?
In SQL:
Select a, b from table where c in ('foo', 'bar', 'baz') OR
Select a, b from table where c in (select e from some_other_table)
TIA
I doubt there will be a need to loop through all the data simply use a formula in the entire column and replace with the resulting value. Like this:
Sub Test()
With ActiveSheet.UsedRange.Columns(3).Offset(1)
.Formula = "=IF(ISERROR(MATCH(B2,A:A,0)),"""",B2)"
.Value = .Value
End With
End Sub
The code above looks at all values in the B column to test for a match in the A column. If match is found then the B column value is displayed in the c column. If no match is found it displays a blank cell but you can change that to whatever you want.