Macro generic formula - vba

I have an Excel sheet with four columns (A-D) as below:
1 XYZ 100 800
2 XYZ 250 820
3 XYZ 500 1100
4 XYZ 4,000 1200
I want to compute the column E values as below :
E1 = (D1-D1)*C1
E2 = (D2-D1)*C1
E3 = (D3-D1)*C1+(D3-D2)*C2
E4 = (D4-D1)*C1+(D4-D2)*C2+(D4-D3)*C3
and so on if there are additional rows
Expected Results: E1=0, E2=2000, E3=100000, E4=185000
Is it possible to generalize this formula? Any help is highly appreciated.

You're not going to be able to generalize this formula in the cell, because the formula needs to grow. Also, there is a character limit for formula in Excel cells (see #pnuts comment, below), so you can't reliably use VBA to "build" the formula because after a certain number of rows, you'll exceed that threshold. And while your use-case may not run in to this limitation, in cases like this I would prefer the simplicity of a UDF over a VBA subroutine that "builds" a long formula string.
You can write a custom function that computes the value by iterating the range. This works on your example data. Place the code in a standard code module.
Public Function GetValue(ByVal clStart As Range, ByVal clEnd As Range) As Variant
'Pass only the cell address for the first cell ("D1") and the last cell ("D4")
Dim rng As Range
Dim r As Range
Dim i As Long
Dim myVal As Double
Application.Volatile
If Not clStart.Column = clEnd.Column Then
'These cells should be in the same column, if not
' display an error
myVal = CVErr(2023)
GoTo EarlyExit
End If
Set rng = Range(clStart.Address, clEnd.Address)
For i = 1 To rng.Rows.Count - 1
Set r = rng.Cells(i)
myVal = myVal + _
((clEnd.Value - r.Value) * r.Offset(0, -1).Value)
Next
EarlyExit:
GetValue = myVal
End Function

quite late, but why couldn't you just use
..
E4 = D4*SUM(C$1:C3)-SUMPRODUCT(C$1:C3,D$1:D3)
..
instead of
E4 = (D4-D1)*C1+(D4-D2)*C2+(D4-D3)*C3
To prevent a performance hit, if it's possible to use temp columns, you could create columns to store partial sums of C and C*D.

Related

Removing loops to make my VBA macro able to run on more data

in my data there are more than a thousand different six digit numbers that are reoccurring in no specific pattern. I need to find all six digit codes that exist in column A and for each number. For example 123456, then find summarize the value in column B for every row that has 123456 in column A. My code is not very effective but the runtime is not a problem if I run with only 10 rows. However, in the real data sheet there are 80 000 rows and my code will take to much time. Can someone help me edit my code but removing certain loops within loops or some stop conditions. I'm new to VBA and can't do it myself in the limited time I have.
Sub Test2()
Dim summa As Long
Dim x As Long
Dim condition As Boolean
Dim lRows As Long
Dim k1 As Integer
Dim i As Long
x = 1
Worksheets("Sheet1").Activate
For i = 100000 To 999999
k1 = 1
lRows = 10
condition = False
While k1 <= lRows
If Cells(k1, "A").Value = i Then
condition = True
End If
k1 = k1 + 1
Wend
If condition = True Then
Cells(x, "F").Value = Application.SumIf(Range("A:A"), CStr(i), Range("B:B"))
Cells(x, "E").Value = i
x = x + 1
End If
Next i
MsgBox "Done"
End Sub
You don't need VBA for this task. Follow these steps.
Insert a blank column C in a copy of the original data sheet.
Insert a SUMIF formula, like =SUMIF(A:A, A2, B:B) in C2 and copy all the way down.
Now all items 123456 will have the same total in column C
Copy column C and Paste Values (to replace the formulas with their values).
Delete column B.
Remove duplicates.

Trying to create a macro to perform 100 iterations and paste resulting values (2 adjacent row cells) to a 2 x 100 array

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.

Comparing the colour of two cell ranges [VBA]

wondering if anyone can help.
I'm a CS teacher and as a part of my current Y10 scheme we're looking at how images are represented by binary. I've created a file that encourages the user to recreate some pixel art based on the binary code provided.
However - now this is where I'm completely stuck - I'm trying to create a macro that allows the user to check whether their colours match what the final result will be. I understand how to compare the two colours, but getting it to work in the large range I have is where it's falling down.
The code I've got so far is:
Function Inc(ByRef i As Long)
i = i + 1
End Function
Sub CompareCellColors()
Dim Rng1 As Range
Set Rng1 = Range("C1:O19")
Dim Rng2 As Range
Set Rng2 = Range("AC1:AO19")
Dim x As Long
x = 0
For Each c1 In Rng1
For Each c2 In Rng2
If c1.Interior.ColorIndex = c2.Interior.ColorIndex Then
Inc x
End If
Next c2
Next c1
If x = 247 Then
Range("A3").Value = True
Else
Range("A3").Value = False
End If
End Sub
I've included my attempt at a workaround (incrementing a variable if they match) but this doesn't work either.
The program compiles and runs, but doesn't accurately compare the two cell ranges (hopefully that explanation makes sense!). The current result of the x increment is 61009, however the selection only has 247 cells.
You are comparing every pixel in Rng1 to every pixel in Rng2 because the loops are nested. I believe what you want is to compare on a more one-to-one basis. Try instead
For a = 1 to 19 'rows
for b = 3 to 13 'columns
If Cells(a, b).Interior.ColorIndex = Cells(a, b + 29).Interior.ColorIndex Then
Inc x
End If
Next b
Next a

Excel VBA Function Lookover - Cooccurrences of two values

I've been working on a user-defined function in VBA to find a certain count. For background, "raw" is a worksheet that refers a sheet that has genres in column B and an artist ID in column C. The sheet that I'm working in has combinations of two genres: first in column A, second in column B.
Anyway, the function that I'm trying to build should do the following:
Take two inputs as strings. Check the genre column in "raw" for matches with the first input. Then, take that ID and find a cell that matches the ID and the second input. If there is one found, add one to a running count. Whether or not it is found, move onto the next match. The function will return an integer that indicates the number of times the two genres had the same artist ID.
Now, my function is returning #VALUE.. no syntax errors, no compiling errors. Just the error in returning the value. I've looked it over, googled like crazy, and I just can't figure it out. I'm new to VBA, so maybe I'm just missing something really obvious or I've defined something wrong. Either way, I just need another set of eyes to look over it. Any suggestions for improvement are much appreciated, so thank in advance for your time and help!!
Here is the code. I know it isn't the prettiest, but it's short and the logic should make sense.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell1 As Range
Dim ID As Integer
Dim Count As Integer
rng = Worksheets("Raw").Range("B2:B183579")
rng2 = Worksheets("Raw").Range("C2:C183579")
Count = 0
For Each cell In rng
If cell.Value = c1 Then
ID = cell.Offset(0, 1).Value
For Each cell1 In rng2
If cell1.Value = ID And cell1.Offset(0, -1).Value = c2 Then
Count = Count + 1
End If
Next cell1
End If
Next cell
cocount = Count
End Function
EDIT: Thanks for viewing my question and being willing to help (And thanks Rdster for attempting a solution). I uploaded pictures of the raw data and the combination, although it won't let me embed the images. Raw Data Combination List
Anyway, I'll try and explain my problem again. In the combination list of genres, each row contains two genres. I want to find how many times those two genres share the same artist ID in the Raw Data sheet. There are 181,000+ combinations, and 183,000+ rows in the Raw Data. Thus, the function needs to be efficient--something that I'm not incredibly great at doing even in other languages.
This can be achieved using built-in several different Excel Worksheet functions.
Excel Formula using COUNTIFS
Define 2 dynamic named ranges that will resize themselves to fit the data. Gendre_2 is defined relative to Gendre_1 this ensures that the ranges are the same size.
Gendre_1 = OFFSET(Raw!$A$1,1,0,COUNTA(Raw!$A:$A)-1,1)
Gendre_2 = OFFSET(Raw!$A$1,1,1,COUNTA(Raw!$A:$A)-1,1)
Formula
=COUNTIFS(Gendre_1,A2,Gendre_2,B2)
Reference: ExcelJet - Excel COUNTIFS Function
COUNTIFS counts the number of cells in a range that match supplied criteria. Unlike the COUNTIF function, COUNTIFS can apply more than one set of criteria, with more than one range. Ranges and criteria are applied in pairs, and only the first pair is required. For each additional criteria, you must supply another range/criteria pairs. Up to 127 range/criteria pairs are allowed.
VBA
Public Function cocount(c1 As String, c2 As String) As Double
Dim rng As Range, rng2 As Range
With Worksheets("Raw")
Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set rng2 = rng.Offset(0, 1)
cocount = WorksheetFunction.CountIfs(rng, c1, rng2, c2)
End With
End Function
If I understand correctly, you are trying to count the number of times that c1 and c2 = B# and C# where # is the same row.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim Count As Integer, iRow as Integer
Count = 0
For iRow = 2 to Sheets("Raw").Cells(Rows.Count, "B").End(xlUp).Row
If Cells(iRow, "B") = c1 And Cells(iRow,"C") = c2 Then
Count = Count + 1
End If
Next iRow
cocount = Count
End Function
Check the genre column in "raw" for
matches with the first input. Then, take that ID and find a cell that
matches the ID and the second input.
try this:
Public Function cocount(FirstKey$, SecondKey$, FirstRng As Range, SecondRng As Range) As Long
Dim FirstAccurance As Range, ID$
Set FirstAccurance = FirstRng.Find(FirstKey, , xlValues, xlWhole, xlByRows, xlNext, 0)
ID = Cells(FirstAccurance.Row, SecondRng.Column).Value2
cocount = WorksheetFunction.CountIfs(SecondRng, ID, FirstRng, SecondKey)
End Function
test:

vb excel drag formula for variable number of rows

I have a excel sheet which I am populating using a VB program. The output sheet can have variable number of rows but has 6 columns (A:F). Now I want the column G to have hex2dec of all the rows in column A. Here's an example: Say column A has 400 rows (A1:A400) then I want G1:G400 to have values HEX2DEC(A1:A400). But this is just an example the rows can vary. I have this code so far:
Sub DataMod()
Dim i As Long, R3 As Long
R3 = 1
For i = 1 To sheet.UsedRange.Rows.Count
sheet.Cells(i, 7).Formula = "=HEX2DEC" & sheet.Cells(R3, 1)
R3 = R3 + 1
Next i
End Sub
But it's not working.
Review your HEX2DEC formula string
it doesn't include the necessary ()
the Cells() would return the value of the target cell, not its address (i.e. the result would be =HEX2DEC(1234) instead of =HEX2DEC(A1) - which may or may not be a problem
you could use variable i instead of R3, they both increment from the same starting point at the same increment
I recommend to use FormulaR1C1, you do not have variants there
Sub DataMod()
Dim C As Range
For Each C In ActiveSheet.UsedRange.Columns(1).Cells
C(1, 7).FormulaR1C1 = "=HEX2DEC(RC[-6])"
Next C
End Sub
The danger of UsedRange is that it might include any header rows, so you might want to get around this by selecting the input range manually before you fire your Sub() and work with the Selection object, e.g.
For Each C In Selection.Columns(1).Cells
Try This:
Sub DataMod()
' Get the number of rows used in Column A:
Dim NumRows as Long
NumRows = Range("A1").End(xlDown).Row
' Put the formulas in Column G all at once:
Range("G1:G" & NumRows).FormulaR1C1 = "=Hex2Dec(RC1)"
End Sub