I’m trying to develop a small program using VBA and would like to add to it. As always I’m struggling to get it right any really could use some help on this project. I not sure how does the program move contents down from one cell to the next if the next cell is full without overwriting it and then move that one down.
I hope you can help.
I'm currently using the program below.
Sub do_it()
Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range
Set sht = ActiveSheet
n = sht.Range("A1")
For Each cell In sht.Range("D1:D12,A16:A31,D16:D31,G16:G31,J16:J31,M16:M31").Cells
tmp = cell.Offset(0, 1).Value
If cell.Value = n And tmp Like "*#-#*" Then
'get the first number
num = CLng(Trim(Split(tmp, "-")(0)))
Debug.Print "Found a positive result in " & cell.Address
'find the next empty cell in the appropriate row
Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
'make sure not to add before col L
If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)
cell.Offset(0, 1).Copy rngDest
Exit For
End If
Next
End Sub
I'm trying to have the program move all the number sets down in the column in the 6 column ranges E1:E12,B16:B30,E16:E30,H16:H30,K16:K30,N16:N30.
In only column E1:E12 I need the program to move the set of numbers (could be more than one set of numbers in the range) down to the following cell below it and increase the last number in the set (no limit to the count). So in the example of cell E1 (8-16) would move to E2 and become 8-17 (cell E1 would be blank when after the move).
When sets of number are located in cell E12 they would move to E1 but still increase the last number and would go round and round. Need help on the next one, how does the program move contents down from one cell to the next if the next cell is full without overwriting it and then move that one down, if this makes sense. An example is cell E12, how does it move up to E1 if E1 is full but has to be moved, which goes first?
For the remaining column ranges B16:B30,E16:E30,H16:H30,K16:K30,N16:N30 I need the program to move the set of numbers (could be more than one set of numbers in the range) down to the following cell below it and increase the last number in the set (no limit to the count). So in the example of cell N18 (5-3) it would move it to N19 and become 5-4 (delete the contents in N18 when finished). The second adjacent column to the right of the above, N18 in this case and located in only the following locations: C16:C30,F16:F30,I16:I30,L16:L30,O16:O30 have cells that contain values that must move but with no change in number. Cell O18 would move down to O19 and still have the number of 9.99. After the operation N18 and O18 would then be blank).
The two exceptions are if the last number is a 15, see cell B30 (8-15). Two things must happen:
1) I need the program to reference the number in the following 5 possible cells:
Cell B30 go to cell B32, reference number 1
Cell E30 go to cell E32, reference number 2
Cell H30 go to cell H32, reference number 3
Cell K30 go to cell K32, reference number 4
Cell N30 go to cell N32, reference number 5
Using example B30 the reference number is 1 (B32) so the program would search the range in column D1:D12 for the number 1 and move the set of numbers and increase the last digit, so it would become 8-16 in cell number E1.
2) The value in cell C31 must be moved via referencing the first number in cell B30 as a reference and search the following 10 possible cells: A35,D35,G35,J35,M35,Q35,A39,D39G39,J39,M39,O39 to find that number (in this example 8 would be cell D39 and the number 2.22 would be moved to cell D40.
After this operation there is no contents in either cell B30 and C30.
That’s it.
enter image description here
I not sure how does the program move contents down from one cell to the next if the next cell is full without overwriting it and then move that one down.
This should help with that:
Cells(irow + 1, icol).Insert Shift:=xlDown
Cells(irow, icol).Copy Cells(irow + 1, icol)
Cells(irow, icol).Clear
Related
I am trying to figure out how to autofill a specific range of cells based on already defined data in the same row. My task is more complex, but a simplification of the step can be seen in the code below. What I want to achieve is:
Define a range where I want to output my values
Multiply two values in the same row of the selected range cell (to its left), and output this number in the currently selected range cell. To do this, one of the numbers to be multiplied will be dependant on a string also in the row (which describes its type).
Loop through the defined range and repeat the calculation on each row.
My current code is as follows and outputs a "application defined or object defined error".
Any help would be much appreciated.
For a = Range("P12") To Range("P33") 'Range of cells I want to fill.
If Cells(a, -10).Value = "B" 'If the cell 10 to the left of our "a" value is = "B".
Then c = Cells(a, -10).Value * Worksheets("LCI").Range("D4").Value 'Then new variable "c" = (cell 9 to left of a) * (number from another sheet containing a database)
Cells(a).Value = c 'Update value of selected range cell to contain c which we calculated.
Next 'Repeat for all rows in range.
You are close.
You need to think of a as a cell or Range object. That variable is the cell itself which has properties like a.row and a.column that describe its location on the sheet in which it lives.
When you say Cells(a, -10) you are saying "On the Activesheet I want a Cell where the row is a, and where the column has the number -10". There is no row a (as a is a range/cell object and because you didn't specify which property of a you are wanting here it will default to a.value which is probably nothing) and there is no column -10 on the Activesheet.
Your loop is defined incorrectly. You can use a For Each loop to loop through cells in a range.
Instead:
For Each a In Range("P12:P33")
'clear `c` each loop
c=0
If a.Offset(,-10).Value = "B" Then 'start at cell `a` and move back 10 columns and grab the value
c = a.Offset(, -10).Value * Worksheets("LCI").Range("D4").Value
End If
a.Value = c
Next a
I am a newbie. I want to sum the squares of the numbers in the active column. I am getting an error 'object doesn't support this method'. Here is my code
Sub sum_squares()
Dim total As Integer
Dim c As Range
Dim d As Range
'set d equal to column from active cell down to last non-empty'
d = Range(ActiveCell, ActiveCell.endxldown)
total = 0
For Each c In d
total = total + c.Value ^ 2
Next c
End Sub
Appreciate the help.
Thanks
As has been pointed out you've got the syntax of xlDown incorrect.
You should also start at the bottom and move up - xlDown may not find the last cell.
E.g.
With a value in cell A1:A3 and A1 as the ActiveCell it will correctly return A3.
Same scenario but with A4 left blank and a value in A5 still returns A3.
Same scenario with A1 left blank it returns A2.
This will return a reference from the ActiveCell to the last cell containing a value in that column.
Note that if the ActiveCell is lower down than the last cell containing data you'll get a reference reflecting that.
Set d = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
A Range can be made up of one or more cell references:
Range("A1") and Range("A1,A3,C5") reference individual cells.
Range("A1:C5") and Range("A1", "C5") reference all cells between the first and last address.
A Cell is a single cell reference that uses row and columns identifiers.
Cells("A1") will return an error as it's a full address.
Cells(1,"A") will return A1 (row 1, column A)
Cells(1,1) will also return A1 (row 1, column 1)
The code above is using two cell addresses to reference all cells between the two.
Range(ActiveCell,....) is the reference to the first cell.
Cells(Rows.Count, ActiveCell.Column) is the reference to the second cell using row numbers and column numbers.
If the ActiveCell is in column B then this is the same as writing Cells(1048573,2).
The End(xlUp) then goes from that cell back up to the first one containing data.
There is a syntax error in your code - .endxldown and add Set before assigning range.
Correct it to -
Set d = Range(ActiveCell, ActiveCell.End(xlDown)
What I'm trying to achieve is there are 2 whole numbers in column A & B on the same row. I want to fill the row from Column C to show the whole numbers increments of one between the two numbers.
i.e.
A B C D E F G H I J K L
1 10 1 2 3 4 5 6 7 8 9 10
any help would be appreciated.
Assuming this is Excel and you can open the VBE Editor to use VBA
Here's a macro you can run or call via a button
See the comments in the code to understand what it's doing with the Dataseries fill function
Sub FillData()
Dim intStopAt As Integer
' Set to cell indicated low end of range
Cells(1, 1).Select
' Fill in "Start At" Number
ActiveCell.Offset(0, 2).Value = ActiveCell.Value
' Retrieve and use stop number to fill in series
intStopAt = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 2).DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=intStopAt
End Sub
The below code assumes you have no header and that your value in A1 is always 1, and your value in B1 is the number you want to count to.
This can be modified to be more dynamic, but taking your question as is, this should work for you.
1) Check number to count to (CountTo)
2) Run loop for 1 to CountTo and auto-populate your column headers
To run: Open VBE and paste this code on the sheet where you wish to run it.
Sub Counter()
Dim CountTo As Integer
CountTo = Range("B1").Value
For i = 1 To CountTo
Cells(1, i + 2) = i
Next i
End Sub
This can be done without VBA, perhaps not as neat initially as #dbmitch's answer because the formula has to go across to the maximum possible number.
A1 is start number, > 0
B1 is end number (> A1)
In Cell C1 enter =A1
In Cell D1 enter =IF(AND(C1<$B1,C1>=$A1),C1+1,"") and then
drag/fill right as far as you need to.
I have formulated the code so that you can now select the filled rows (A through to wherever) and fill down.
A simple explanation:
C1 sets the start of the list
The AND formula in D1 onwards checks that the immediate left cell (for D1 this is C1, for E1 this is D1 etc.) is less than the end number and greater than the start number.
If the conditions are true, use the immediate left cell value + 1 as the result.
If the conditions are false, insert a blank.
Further checking can be done, I have assumed in the above solution that the numbers are positive and increasing.
You can use helper columns to indicate if you should increase or decrease (i.e. +1 or -1 as required.
Using a blank as the other answer falls down if the numbers go from -ve to +ve. In this case, you could use another symbol (e.g. x) and check for that in the AND function as well.
you could use this:
Sub main()
Dim cell As Range
With Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) ' reference column A cells from row 1 down to last not empty one with a "constant" (i.e. not a formula result) numeric content
For Each cell In .Cells 'loop through referenced range
cell.Offset(, 2).Resize(, cell.Offset(, 1).Value - cell.Value + 1).FormulaR1C1 = "=COLUMN()-COLUMN(C3)+RC1" 'write proper formula in current cell adjacent cells
Next
.CurrentRegion.Value = .CurrentRegion.Value ' get rid of formulas and leave values only
End With
End Sub
I found a code online which works but I am failing to change it for my purpose. Each entry in my spreadsheet contains different formulas as well as an Iferror function with the aim of making cells with error messages appear as blank. For example lets say a cell E3 is dependent on cell F3 with a certain formula (for clarification lets say F3/2.5). It is obvious if there is no entry in cell F3 then an error message would display in cell E3. For this reason, I use the IFERROR function to display the cell as blank. The difficulty arises when I want to delete blank rows after a click on the macro button. However, since that cell does have an entry (a formula which in turn returns an error message), that cell does not delete. Also I need to run this code over 3 different selection ranges. Please can someone help! The code I found was from a different thread on this forum and is:
`sub foo()
dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range("A1:Z50")
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End Sub`
Thanks Alot!
EDIT: If statement added to the autofilter as it was deleting a row when there were no blanks
You will want to set up a column in the spreadsheet with the following sumproduct:
=SUMPRODUCT((LEN(A1:F1)>0)*1)
This is calculating how many cells' values have a length more than 0 hence are not blank, you will need to adjust cell references accordingly as I tested on a small sample of fake data.
Following this you can just loop:
For i = rows To 1 Step (-1)
If Cells(i,"G") = 0 Then r.rows(i).Delete 'My formula is in column "G"
Next
Or set up an auto-filter and delete entire rows of the visible cells:
Dim lrow As Integer
If Not WorksheetFunction.CountIf(Range("G:G"), "0") = 0 Then
Range("A1:G1").AutoFilter
Range("A1:G1").AutoFilter Field:=7, Criteria1:="0"
lrow = Cells(rows.Count, 7).End(xlUp).Row + 1
Range("G2:G" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("A1:G1").AutoFilter
End If
The only problem with using a leading column to calculate for this is if you have a lot of data coming and going as you will need to replenish the formula, though you could use auto complete in the code i guess.
Let me preface this question by saying I am not super technical so much of my verbiage may seem obscure..
On sheet1 I have three seperate horizontal ranges of cells (3 seperate series of steps):
A1:D1
A2:C2
A3:E3
On sheet two, I'd like to link to create live links to these ranges, such that if I change information on sheet1, it will be automatically reflected in sheet2.
The catch is, that on sheet2, I want the ranges to be listed after one another in one row, to create one long series of steps.
Range1-->Range2-->Range3 (all on one row)
How do I ensure that if I add an additional step to, say, the first range on sheet1, that on sheet 2, the new cell will be added and the following cells will all be pushed over to the right by one cell?
To accommodate ranges that might grow, start from the first cell and then find the last occupied cell with End(xlToRight). Once you've found all the range extents, you can combine them with an array UDF:
Function ConcatRanges(ParamArray ranges()) As Variant()
Application.Volatile
Dim ret() As Variant
ReDim ret(1 To 1, 1 To (Application.Caller.Columns.Count))
Dim RetIdx&, i&, cell As Range
RetIdx = 1
For i = 0 To UBound(ranges)
For Each cell in Application.Range(ranges(i), ranges(i).End(xlToRight))
ret(1, RetIdx) = cell.Value
RetIdx = RetIdx + 1
Next
Next
For RetIdx = RetIdx To UBound(ret, 2)
ret(1, RetIdx) = vbNullString
Next
ConcatRanges = ret
End Function
For your example, you'd call it like this:
=ConcatRanges(Sheet1!A1, Sheet1!A2, Sheet1!A3)