I have a problem with the following code. I would like it to loop through a range (AK2 until end of data) and then any time it finds an empty cell it changes its value to Account receivable. Its not doing it, I also dont get any error notification. My guess is that I´m doing something wrong with setting the variables:
Option Explicit
Private Sub Leere()
Dim rng As range
Dim rcell As range
Dim WS As Worksheet
Set WS = Worksheets("Sheet2")
Set rng = WS.range("AK2", range("AK2").End(xlDown))
For Each rcell In rng
If rcell.Value = " " Then
rcell.Value = "Accounts Receivable"
End If
Next
End Sub
Any ideas?
use SpecialCells()
With ws
.Range("AK2", .Cells(.Rows.Count, "AK").End(xlUp)).SpecialCells(XlCellType.xlCellTypeBlanks).Value = "Accounts Receivable"
End With
You should be able to replace the empty (no formula) cells with something like this:
Set ws = ThisWorkbook.Worksheets("Sheet2")
Set rng = ws.Range("AK2", ws.Cells(ws.Rows.Count, "AK").End(xlUp))
rng.Replace "", "Accounts Receivable", xlWhole
Another non-VBA option can be Conditional Formatting for blank cells. The cell values will still be blank, but the displayed text change will be dynamic.
Related
This question already has answers here:
Delete Column Loop VBA
(2 answers)
Closed 3 years ago.
I have a macro where I search for text in a row and if a column does not have my specified text it is deleted. Here is my code:
Private Sub Test()
Dim lColumn As Long
lColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
Dim i As Long
Dim myCell As Range
Dim myRange As Range
Set myRange = Worksheets("2019").Range(Cells(2, 1), Cells(2, lColumn))
For Each myCell In myRange
If Not myCell Like "*($'000s)*" And Not myCell Like "*Stmt Entry*" And Not myCell Like "*TCF*" And_
Not myCell Like "*Subtotal*" And Not myCell Like "*Hold*" Then
myCell.EntireColumn.Select
Selection.Delete
End If
Next
End Sub
My issue is that when I execute the macro it will only delete some of the columns but not the ones towards the end of the range. If I then run the macro again it will successfully delete all the columns I ask it to.
If I switch the macro to- let's say- make the cells bold instead of deleting them it works perfectly every time.
What am I missing?
Many thanks!
Despite everyone saying "just loop backwards" in this & linked posts, that's not what you want to do.
It's going to work, and then your next question will be "how can I speed up this loop".
The real solution is to stop what you're doing, and do things differently. Modifying a collection as you're iterating it is never a good idea.
Start with a helper function that can combine two ranges into one:
Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
If source Is Nothing Then
'note: returns Nothing if toCombine is Nothing
Set CombineRanges = toCombine
Else
Set CombineRanges = Union(source, toCombine)
End If
End Function
Then declare a toDelete range and use this CombineRanges function to build ("select") a Range while you're iterating - note that this loop does not modify any cells anywhere:
Dim sheet As Worksheet
' todo: use sheet's codename instead if '2019' is in ThisWorkbook
Set sheet = ActiveWorkbook.Worksheets("2019")
Dim source As Range
' note: qualified .Cells member calls refer to same sheet as .Range call
Set source = sheet.Range(sheet.Cells(2, 1), sheet.Cells(2, lColumn))
Dim toDelete As Range
Dim cell As Range
For Each cell In source
'note: needed because comparing cell.Value with anything will throw error 13 "type mismatch" if cell contains a worksheet error value.
'alternatively, use cell.Text.
If Not IsError(cell.Value) Then
If Not cell.Value Like "*($'000s)*" _
And Not cell.Value Like "*Stmt Entry*" _
And Not cell.Value Like "*TCF*" _
And Not cell.Value Like "*Subtotal*" _
And Not cell.Value Like "*Hold*" _
Then
Set toDelete = CombineRanges(cell, toDelete)
End If
End If
Next
The last, final step is to delete the .EntireColumn of the toDelete range... if it isn't Nothing at that point:
If Not toDelete Is Nothing Then toDelete.EntireColumn.Delete
I want to select the entire column that contain the names to copy it knowing that the Name column number can change between a spreadsheet and another and there is some blank cells in the middle (missing value)
Suppose that the Names column is the column B, so if I want to select the entire column even with the some blank cells in the middle I can use the following code:
Range("B2", Range("B" & Rows.Count).End(xlup)).Select
But the Name column number is variable. so i tried to make it like this :
Sub ColSelection ()
Dim NameHeader As range
'To select the header of Name column
Set NameHeader = ActiveSheet.UsedRange.Find("Name")
ActiveSheet.Range(NameHeader.Offset(1,0), Range(NameHeader & Rows.Count).End(xlUp)).select
' run tim error 1004 " Methode 'Range' of object '_Global' Failed
End sub
I guess that I have to replace the second NameHeader with his column address. how to do that? Should I set a Var to store the address of the range NameHeader, and use it. If it's the case how should I set this var, I mean as long or as Variant..ect?
Thanks :)
Is this what you are trying? I have commented the code so you should not have a problem understanding it. But if you still do then post your query.
Is this what you are trying?
Sub ColSelection()
Dim NameHeader As Range
Dim ws As Worksheet
Dim ColName As String
Dim LRow As Long
Dim rng As Range
Set ws = Sheet1 '<~~ Change as applicable
With ws
Set NameHeader = .UsedRange.Find("Name")
'~~> Check if we found the text
If Not NameHeader Is Nothing Then
'~~> Get the Column Name
ColName = Split(Cells(, NameHeader.Column).Address, "$")(1)
'~~> Get the last row in that range
LRow = .Range(ColName & .Rows.Count).End(xlUp).Row
'~~> Construct your range
Set rng = .Range(ColName & NameHeader.Row & ":" & ColName & LRow)
With rng
MsgBox .Address
'~~> Do whatever you want with the range
End With
End If
End With
End Sub
Screenshot
Unable to upload an image, Imgur is rejecting images for the time being. Will update it directly later.
http://prntscr.com/kftsad
No need to look at NameHeader.Address - just use its .Column - something like this (noting that you don't have to Select a Range before copying.
Sub GrabNameCol()
Dim NameHeader As Range
Set NameHeader = ActiveSheet.UsedRange.Find("Name")
If Not NameHeader Is Nothing Then
ActiveSheet.Range(NameHeader.Offset(1), Cells(Rows.Count, NameHeader.Column).End(xlUp)).Select ' or just .Copy
End If
End Sub
Sub test1a()
Dim NameHeader As Range
Set NameHeader = ActiveSheet.UsedRange.Find(InputBox("HEADER"))
If Not NameHeader Is Nothing Then
ActiveSheet.Range(NameHeader.Offset(1), Cells(Rows.Count, NameHeader.Column).End(xlUp)).Select
End If
End Sub
I am trying to clear all the columns after the last header row
The macro runs but no clearing happens, I have played with the syntactic for awhile and am not getting it
Thanks
Sub ClearColumnsAfterLastHeader()
Dim ws As Excel.Worksheet
Dim hNames As Variant
Dim cell
Set ws = ActiveWorkbook.Sheets("Finished")
hNames = ws.Range("A1:R1").Value
For Each cell In hNames
If IsEmpty(cell) Then
cell.EntireColumn.ClearContents
End If
Next cell
End Sub
The main problem of your code is that hNames is array of Variant rather than Range and when you're looping through array For Each cell In hNames, variable cell refers to array element rather than to corresponding cell. So, you can't use cell.EntireColumn.ClearContents, because cell is not Range, but Variant.
As per my understanding of question, you want to determine last filled cell in first row (header row) and clear contents of all columns to the right of last filled header. In that case try code below:
Sub ClearColumnsAfterLastHeader()
Dim ws As Excel.Worksheet
Dim lastHeaderColumn As Long
Set ws = ActiveWorkbook.Sheets("Finished")
With ws
'determine last filled cell in first row
lastHeaderColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
'get of all cells to the right and down and clear contents
.Range(.Cells(1, lastHeaderColumn + 1), _
.Cells(.Rows.Count, .Columns.Count)).ClearContents
End With
End Sub
Cant you just do something like
Sub ClearStuff()
Dim ws As Worksheet
Dim LastCell As Range, ClearRange As Range
Set ws = ActiveWorkbook.Sheets("Finished")
Set LastCell = ws.Cells(1, ws.Columns.Count)
Set ClearRange = Range(LastCell.End(xlToLeft).Offset(0, 1), LastCell)
ClearRange.EntireColumn.ClearContents
End Sub
I'd like to create a macro that selects a rectangular range of cells and sets the name of every one of those cells to the value/contents of the cell.
In terms of what I've thought so far, I get an error though with the cell.Name line.
Public Sub NameCell()
Dim rng As Range
Dim cell As Range
Set rng = Range("A1:D1")
For Each cell In rng
cell.Name = CStr(cell.Value)
Next
End Sub
Is this what you meant?
Sub setVal()
Range("A1:C6").Select
Selection = "value"
End Sub
I believe this may work for you unless I also misunderstood the question.
Dim r As Range
Dim cell As Range
Set r = Sheet1.UsedRange
For Each cell In r
Sheet1.Names.Add Name:=cell.Value, RefersTo:=cell
Next
Keep in mind, though, that you would want to check that the cell.Value is valid (no spaces, etc.) for a named range.
To replace a range of cells with their values (removing any formulas from the range), you would use something like this.
Public Sub NameCell()
Dim rng As Range
Set rng = Range("A1:D1")
rng.Value = rng.Value
End Sub
I want to test if a given cell is within a given range in Excel VBA. What is the best way to do this?
From the Help:
Set isect = Application.Intersect(Range("rg1"), Range("rg2"))
If isect Is Nothing Then
MsgBox "Ranges do not intersect"
Else
isect.Select
End If
If the two ranges to be tested (your given cell and your given range) are not in the same Worksheet, then Application.Intersect throws an error. Thus, a way to avoid it is with something like
Sub test_inters(rng1 As Range, rng2 As Range)
If (rng1.Parent.Name = rng2.Parent.Name) Then
Dim ints As Range
Set ints = Application.Intersect(rng1, rng2)
If (Not (ints Is Nothing)) Then
' Do your job
End If
End If
End Sub
Determine if a cell is within a range using VBA in Microsoft Excel:
From the linked site (maintaining credit to original submitter):
VBA macro tip contributed by Erlandsen Data Consulting
offering Microsoft Excel Application development, template customization,
support and training solutions
Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Sub TestInRange()
If InRange(ActiveCell, Range("A1:D100")) Then
' code to handle that the active cell is within the right range
MsgBox "Active Cell In Range!"
Else
' code to handle that the active cell is not within the right range
MsgBox "Active Cell NOT In Range!"
End If
End Sub
#mywolfe02 gives a static range code so his inRange works fine but if you want to add dynamic range then use this one with inRange function of him.this works better with when you want to populate data to fix starting cell and last column is also fixed.
Sub DynamicRange()
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range
Set sht = Worksheets("xyz")
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Set rng = Workbooks("Record.xlsm").Worksheets("xyz").Range(Cells(12, 2), Cells(LastRow, 12))
Debug.Print LastRow
If InRange(ActiveCell, rng) Then
' MsgBox "Active Cell In Range!"
Else
MsgBox "Please select the cell within the range!"
End If
End Sub
Here is another option to see if a cell exists inside a range. In case you have issues with the Intersect solution as I did.
If InStr(range("NamedRange").Address, range("IndividualCell").Address) > 0 Then
'The individual cell exists in the named range
Else
'The individual cell does not exist in the named range
End If
InStr is a VBA function that checks if a string exists within another string.
https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/instr-function
I don't work with contiguous ranges all the time. My solution for non-contiguous ranges is as follows (includes some code from other answers here):
Sub test_inters()
Dim rng1 As Range
Dim rng2 As Range
Dim inters As Range
Set rng2 = Worksheets("Gen2").Range("K7")
Set rng1 = ExcludeCell(Worksheets("Gen2").Range("K6:K8"), rng2)
If (rng2.Parent.name = rng1.Parent.name) Then
Dim ints As Range
MsgBox rng1.Address & vbCrLf _
& rng2.Address & vbCrLf _
For Each cell In rng1
MsgBox cell.Address
Set ints = Application.Intersect(cell, rng2)
If (Not (ints Is Nothing)) Then
MsgBox "Yes intersection"
Else
MsgBox "No intersection"
End If
Next cell
End If
End Sub