I need to get the maximum value from two columns and send it to a third column. The columns are all uniform in size but sometimes the sizes will be different, however they will all start in the same cell. For example:
5 8 -
6 2 -
6 5 -
The column with the dashes would need to find the maximum between the other two, and the finished project would look like
5 8 8
6 2 6
6 5 6
I tried recording a macro but it used ActiveCell which isn't good. I want The two columns to be, say, anything starting from C10 that has a value, and everything starting in D10 that has a value, and the max values sent to E10.
Here's what I recorded, trying to just fill the destination cell with the formula:
ActiveCell.FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
Selection.AutoFill Destination:=Range("E10:E300"), Type:=xlFillDefault
Here is a good alternative of your code, just make sure to declare the first column that you compare with. The example works with the first 10 cells of Column A:
Option Explicit
Public Sub SelectMax()
Dim rngRange As Range
Dim rngCell As Range
Set rngRange = Range("A1:A10")
For Each rngCell In rngRange
'Without visible formula in Excel:
rngCell.Offset(0, 2) = WorksheetFunction.Max(rngCell, rngCell.Offset(0, 1))
'With visible formula in Excel
rngCell.Offset(0, 2).FormulaR1C1 = "=MAX(RC[-2],RC[-1])"
Next rngCell
End Sub
The example makes a visible formula in Excel. If you want to ignore the formula, remove the line after the second comment and the formula will not appear.
Related
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 have a worksheet that uses randomly generated numbers in calculations to produce results in two adjacent cells (let's say A1 and A2). I am trying to perform 100 iterations where I'm simply "Calculating Formulas" on the worksheet and then trying to store the results of each iteration next to A1 and A2 (so iteration 1 would be in B1 and B2 and iteration 100 would be in CW1 and CW2). Thanks in advance for your help. Using Excel 2010 if that matters.
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
For i = 1 To Iteration
Calculate
Range("A1:A2").Select
Selection.Copy
Range("B" & Rows.Count).End(x1Up).Offset(0, 1).PasteSpecial
Paste:=xlPasteValues
Next i
End Sub
I think your major problem was with the location you were selecting for the destination address - you were finding the last unused cell in column B, then shifting over one column (i.e. to column C) and pasting the first set of results. Then you were using that same location for the second set of results, etc.
Sub Test()
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
'Use a "With" block so that it can be easily changed in the future
'to refer to a specific sheet if needed
With ActiveSheet
For i = 1 To Iteration
Calculate
'Determine the last used column on row 1,
' offset 1 column to the right,
' resize to refer to 2 rows,
' set values to the values in A1:A2
.Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Resize(2, 1).Value = .Range("A1:A2").Value
Next i
End With
End Sub
As pointed out by Steve Lovell, you also had a typo in your original code. It is a good habit to include Option Explicit as the first line in every code module. That will force you to declare all the variables that you use, and the compiler would have highlighted x1Up and given a "Variable not defined" error.
I have some data in Excel grouped into blocks of data in a single column. Each block has a serial number identifying at the top, then a space, and then the associated data. The format is similar to the following:
20204
0.009447773
0.008672609
0.04769611
0.041069839
-0.035158783
-0.06094639
0.059548043
0.029640036
8081
0.003970223
-0.024156246
0.063038863
0.005341972
0.124618374
0.005495709
0.098642513
0.005636186
0.063350961
0.128130779
106663
0.115009077
0.049194194
-0.057100467
0.037476741
0.063087314
0.072773643
0.003909923
0.000448073
0.008006874
0.008718021
0.009883258
-0.022708477
0.028655466
The blocks occur at regular intervals and are all the same length (spaced by 2007 cells). So the first serial number appears at D19, the next at D2026, then D4033, etc. This extends for several thousand rows.
I want to multiply each of the blocks of numbers by a different amount based on their serial number. So I'd want to multiply everything in the first block by 0.5, everything in the second by 2, everything in the third by 1.2, etc, according to a table such as:
Serial Scalar
20204 0.5
8081 2
106663 1.2
What would be the most efficient way to do this, either by VBA or in a formula in an adjacent cell?
you could expolit Areas property of Range object
Option Explicit
Sub main2()
Dim iArea As Long
Dim serialToScalarTable As Range, cell As Range
Dim multiplier As Double
Set serialToScalarTable = Range("A2:B4") '<--| table where you have serial/scalar correspondence
With Range("D19", Cells(Rows.count, 4).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers)
For iArea = 2 To .Areas.count Step 2
multiplier = Application.VLookup(.Areas(iArea - 1).Value, serialToScalarTable, 2, False)
For Each cell In .Areas(iArea)
cell.Value = cell.Value * multiplier
Next
Next
End With
End Sub
I'm completely new to VBA and Excel macros in general so I'll try to explain my predicament as clearly as possible. Basically I've got two workbooks, the source workbook which contains a single worksheet with nearly thousands of rows and columns and another workbook with 90+ worksheets, each with two tables that references cells from the source workbook (the tables cover monthly data for the last four fiscal years).
I've shoe-stringed together an automation macro that mostly works, but my primary concern is that it could be done better, specifically I've got one section of code:
'October
cellVarO = ActiveSheet.Range("B8").Formula
cellVarO = Right(cellVarO, 5)
Range("B8").Select
ActiveCell.Formula = "=OFFSET('C:\external\[reference_sheet.xls]Mnthly Rdgs'!" & cellVarO & ",0," & fyNum * 12 & ")"
One thing to note is that this code repeats 24 times, one for each month, and another iteration to use MID so that I'm still selecting the right cell value from the active cell formula (after changing the original formula to include OFFSET). I find this bulky and unnecessary but it's the only way I can wrap my mind around the problem. Another issue, it considers that the cell reference will always be 5 characters long. There are instances where this is not the case.
But basically my months are laid out by column and my years are laid out by row, what I was aiming to do here was look in the cell formula for the cell reference, select the cell value, then use OFFSET to shift the value 12 columns to the most recent one, and print the new value to the most recent year. Suppose if I have the cell formula:
='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938
My goal is to take the cell value here (QR938) and shift it right 12 columns. Is there any way to pick out the cell value (other than using MID/RIGHT) and assign it to a variable to offset? Is there a better way to shift the cell value 12 columns other than using OFFSET? Finally, is there any way to perform that same operation across multiple similarly formatted worksheets?
See if this helps
For testing the main code:
Sub Tester()
'offset 12 cols to right
OffsetFormulaReference ActiveSheet.Range("B8"), 0, 12
'offset 12 cols to left
OffsetFormulaReference ActiveSheet.Range("B9"), 0, -12
'offset 12 rows down
OffsetFormulaReference ActiveSheet.Range("B10"), 12, 0
'offset 12 rows up
OffsetFormulaReference ActiveSheet.Range("B11"), -12, 0
'EDIT: loop over sheets and edit a specific range
Dim c As Range, sht as WorkSheet
For Each sht in ThisWorkbook.Sheets
For each c in sht.Range("B8:B20").Cells
OffsetFormulaReference c, 12, 0
Next c
Next sht
End Sub
Utility method for taking the formula from a cell with an external reference and moving it over by the specified number of rows/columns:
Sub OffsetFormulaReference(c As Range, offsetRows, offsetCols)
Dim origForm As String, origAddr As String
Dim arr, rng As Range, newAddr As String
If c.HasFormula Then
origForm = c.Formula
'(e.g.) ='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938
If InStr(origForm, "!") > 0 Then
arr = Split(origForm, "!") 'arr(1) = "QR938"
Set rng = ActiveSheet.Range(arr(1)) 'get a range reference
Set rng = rng.Offset(offsetRows, offsetCols) 'move the reference
newAddr = rng.Address(False, False) 'get the offset address
'replace old formula with new offset reference
c.Formula = arr(0) & "!" & newAddr
End If
End If
End Sub
Note: you'll get an error if you try to use Offset() to move the rng reference beyond the limits of the sheet (eg. row or column < 1). You can add logic to handle that if it might be an issue.
I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i