Sum of range in a specific cell with predefined range in vba - excel

I have a selected range that I defined as my range. I want to get the Sum of this selection in a specific cell.
The makro shall find "x", select the cell below and put in "Sum" + the range I defined in "myrange"
Sub more_twelve_months()
Dim myrange As Range
Set myrange = Range(Range("F5"), Range("F5").End(xlToRight))
Set more_twelve_months = Range("A1:ZZ10000").Find("x")
more_twelve_months.Select
FormularCell = ActiveCell.Offset(1, 0).Select
Selection.Resize(Selection.Rows.Count, _
Selection.Columns.Count).Select
ActiveCell.Sum (myrange)
I tried several ways to get the sum, ActiveCell.Sum (myrange) is just the last thing I tried.
Any ideas how I can solve this?

Is this what you want?
You should avoid using Select as far as possible.
Sub more_twelve_months()
Dim myrange As Range
Dim more_twelve_months As Range 'declare your variables
Set myrange = Range(Range("F5"), Range("F5").End(xlToRight))
Set more_twelve_months = Range("A1:ZZ10000").Find("x")
If Not more_twelve_months Is Nothing Then 'check you've found something to avoid errors
more_twelve_months.Offset(1).Value = Application.Sum(myrange)
End If
End Sub

Related

Delete Excel Rows using vba on the basis same values in two columns [duplicate]

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

For Loop not fully cycling in excel VBA [duplicate]

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

Selecting a cell on top of a range

I now have a range A2:A10
But I need to select A1, how can I do that?
Thanks in advance!
Edit:
Sorry I should be more specific. It's part of a loop so the range is dynamic.
The following code solved my problem. I needed this to work for any columns not just A2:A10.
Sub test2()
Dim myRange As Range, desiredRange As Range
Set myRange = ThisWorkbook.Worksheets("Sheet1").Range("A2:A10")
Set desiredRange = myRange.Resize(1, 1).Offset(-1)
desiredRange.Select
End Sub
There is no loop shown in your code. If you repeatedly set the variable myRange using a single column then you simply use
myRange.Cells(1,1)
to refer to the first cell
set the range then loop item in range and select first item:
Dim Cell As Range, ws As Worksheet
Set ws = ActiveSheet
For Each Cell In ws.Range("A2:A10")
Cell.Select
exit for
Next Cell

Loop through range and find empty cells

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.

Setting the name of each cell to its content/value

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

Resources