I'm a newbie and I'm trying to learn VBA (Sorry for any mistake in English, I'm not a native speaker).
I am trying to solve the following assignment:
"Create a procedure that outputs the multiplication table values from 11 to 20 in Excel as shown below:"
multiplication table
This is my code:
Sub einmaleins()
Dim x As Integer, y As Integer
For x = 11 To 20
For y = 11 To 20
Cells(x, y) = x * y
Next
Next
End Sub
It works but puts the table from K11 to S20. I need it to enter the values from A1 to J10
I have tried
*Range("A1:J10").FormulaR1C1 = "=ROW(RC)*COLUMN(RC)"*
but it doesn´t work.
Help is greatly appreciated
In fact your formula approach is better as avoids a loop.
Range("A1:J10").FormulaR1C1 = "=(ROW(RC)+10)*(COLUMN(RC)+10)"
You can subtract 10 from each x and y coordinate.
For example, x = 11 and y = 11 would give cells(1, 1).
Sub einmaleins()
Dim x As Integer, y As Integer
For x = 11 To 20
For y = 11 To 20
Cells(x - 10, y - 10) = x * y
Next
Next
End Sub
Here you go if you want more control over the code and if you plan to use this repeatedly. It will not matter even if it is 11- 20 or any other number.
Also recommend that you refer the cell with the sheet reference so that when you go on you will have no issue with referencing. EG : Sheet1.Cells (y,x)
Here you go - The function.
Function einmaleins(fNumber As Integer, lNumber As Integer) As Integer
Dim x, y As Integer
For x = fNumber To lNumber
For y = fNumber To lNumber
Sheet1.Cells(x - (fNumber - 1), y - (fNumber - 1)) = x * y
Next
Next
End Function
//Call the function
Sub multiTable()
Call einmaleins(11, 20)
End Sub
Hope this helps
Tschüss
Related
(I'm a straight up beginner, first month of assignments of vba)
In my assignment, I was given an excel file with 4 sheets (of which, for my question, only the first three matter). Each of those first three's names end with the date (MM/YY) (0920, 1020 and 1120 respectively). In all those sheets I have two columns - one with a minimum value, and the other with the real value.
I need to create a procedure that, with a certain input of month and year, goes to the respective sheet and calculates how many cells with the real value have a value larger than their respective minimum value.
I tried this:
Sub ArtigosArmazem()
folhas = Array("Stock final 0920", "Stock final 1020", "Stock final 1120")
For i = LBound(folhas) To UBound(folhas)
Worksheets(folhas(i)).Activate
Next
Dim n As Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = setembro Then
i = "Stock final 0920"
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
("Ano" means year, "Mês" means month and "setembro" means september in portuguese)
But it kept outputting "0" in the Message Box. Any help or tips?
If I understand the issue, then I think you need something like this using VBA.
Sub ArtigosArmazem()
Dim x as Integer
Dim y as String
Dim n as Integer
dim k as Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = "setembro" Then
Sheets("Stock final 0920").Activate
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
With this method you have to watch out for the capitalization of "setembro". In VBA unlike Excel, "setembro" <> "Setembro".
It might be easier to use =SUMPRODUCT((H3:H510>G3:G510)*1) in each sheet instead of VBA.
This works in my version of Excel O365. I believe it will work in earlier versions as well.
I am new to Vba and I have been trying to figure out how after an if statement to multiply two numbers in two different columns. the data in excel is laid out as below.What I am trying to do is to multiply the cost with the weight if the freighttype is for example store transfer but my code below does not work.Your help would be much appreciated.I do not know if I need two extra for loops for the cost and weight.
freighttype
Column(b)
Store Transfer
Ecommerce
Cost
Column(c)
7
6
Weight
column (e)
2
3
And the code is:
Option Explicit
Function essay(ft As Range) As Long
Dim x As Variant
For Each x In ft
If ft = "store transfer" Then
essay = Range("b2:b365").Offset(0, 1) * Range("b2:b365").Offset(0, 3)
Else
essay = 0
End If
Next x
End Function
Unlike Excel, you cannot multiply two arrays together in VBA.
For the equivalent, you can either loop through all the cells, multiplying them one by one and keeping a running total, or you can use the SUMPRODUCT worksheet function inside EVALUATE
Assuming, for example, that your ft range is in column B, starting with B2, you could use something like:
Option Explicit
Option Compare Text
Function essay(ft As Range) As Long
essay = Evaluate("=SUMPRODUCT((" & ft.Address & "=""store transfer"")*OFFSET(" & ft.Address & ",0,1)*OFFSET(" & ft.Address & ",0,3))")
End Function
for looping:
Function essay2(ft As Range) As Long
Dim c As Range
Dim L As Long
For Each c In ft
If c = "store transfer" Then _
L = L + c.Offset(0, 1) * c.Offset(0, 3)
Next c
essay2 = L
End Function
Note that the Option Compare Text statement makes the routine case insensitive.
Hi Guys I managed to solve the problem with your help ,please find the solution below.
Option Explicit
Function ecco(ft As Range) As Long
Dim x As Variant
Dim L As Long
For Each x In ft
If ft = "st" Then
L = x.Offset(0, 1) * x.Offset(0, 3)
Else
ecco = 0
End If
ecco = L
Next x
End Function
Everyone,
I'm trying to automated my excel file to choose random data to check for audit. I want to make randomizer that I can input how many data to select. is that possible in excel? I put some screenshot below for better explanation. I hope you can help me.
Using the usual excel functions this is indeed impossible...
However, excel (and the other Microsoft office applications) run an underlying programming language: visual basic. That's the way to go :)
Here's a makro, that selects a random field matching the search in the whole column.
Sub SelectRandomSearch()
'Declaring Variables
Dim y As Integer
Dim x As Integer
Dim startY As Integer
Dim lastY As Integer
Dim search As String
Dim hits As Integer
Dim random As Integer
Dim hitsArr() As Integer
Dim controlPart As Double
Dim controlsNum As Integer
Dim controlArr() As Integer
'Declaring Values
startY = 1 'lowest Y-Coordianate of the input column
x = 1 'X-Coordiante of the input column
controlPart = 0.1 'Fraction of the hits, that need to be controled
'Get search value
search = InputBox("Enter a search value", "Searching", "")
'Getting Column Lenght and reset coloring
y = startY
Do Until IsEmpty(Cells(y, x).Value)
Cells(y, x).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
y = y + 1
Loop
'Getting number of search hits
lastY = y - 1
hits = WorksheetFunction.CountIf(Range(Cells(startY, x), Cells(lastY, x)), search)
'Fill hitsArr with row-numbers of hits
ReDim hitsArr(hits + 1)
hits = 1
For y = startY To lastY
If Cells(y, x) = search Then
hitsArr(hits) = y
hits = hits + 1
End If
Next y
hits = hits - 1
'Getting number of controlled Entries
controlsNum = WorksheetFunction.RoundUp(hits * controlPart, 0)
'Shuffle a part of hitsArr
ReDim controlArr(controlsNum + 1)
For y = 1 To controlsNum
random = ((hits - y + 1) * Rnd + y)
hitsArr(0) = hitsArr(y)
hitsArr(y) = hitsArr(random)
hitsArr(random) = hitsArr(0)
Next y
'Mark every hit that needs to be controlled
For y = 1 To controlsNum
Cells(hitsArr(y), x).Select
With Selection.Interior
.Color = 49407
End With
Next y
End Sub
You probably need to change the makro slightly, but this basicly does all I can think of you could need :)
I hope this helps!
Now the makro marks the fields that need to be checkt like this:
I'm struggling with a complex excel problem, and I would be amazed by any solution.
I have a table with 4 columns and the following values
The highest |13|12|12|12|
The two highest|11|12|11|11|
The two highest|12|12|12|12|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
My problem requires from the first three rows to select the highest respectively the two highest values. Over the complete matrix there should be a sum of 12 values.
The required 5 plus whatever are the remaining 7 highest values. My current approach is to do a sum of the required rows and add the rest together, but that is obviouly not working.
|13|12|12|12|[MAX(B10:E10)]13|
|11|12|11|11|[LARGE(B11:E11;1)+LARGE(B11:E11;2)23|
|12|12|12|12|[LARGE(B12:E12;1)+LARGE(B12:E12;2)24|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
Any ideas or suggestions are highly appreciated. Also a more understandable title for references would be great. Thanks!
Explanation:
It's sloppy VBA, but this works and the structure is generally expandable if you need it to be. You can just paste this in a VBA module, run Sum57(), and the result will be in the debug window (Ctl + G). To modify this for other array sizes, change the following :
the size of the used array in line 1
the values of arrR and arrC in lines 5 and 6 which define the start of the array
the pattern of the function calls in the body of Sum57()
The base pattern is:
For i = 1 To N
x = x + LargeOfRange([rStart], [rEnd], [cStart], [cEnd])
Next
where N is top N largest numbers from the range.
VBA:
Public used(5, 3) As Boolean
Public arrR, arrC As Integer
Public Sub Sum57()
arrR = 10
arrC = 2
For a = LBound(used, 1) To UBound(used, 1)
For b = LBound(used, 2) To UBound(used, 2)
used(a, b) = False
Next
Next
Dim x As Integer
x = x + LargeOfRange(10, 10, 2, 5)
For i = 1 To 2
x = x + LargeOfRange(11, 11, 2, 5)
Next
For i = 1 To 2
x = x + LargeOfRange(12, 12, 2, 5)
Next
For i = 1 To 7
x = x + LargeOfRange(10, 15, 2, 5)
Next
Debug.Print x
End Sub
Public Function LargeOfRange(rStart As Integer, rEnd As Integer, _
cStart As Integer, cEnd As Integer) As Integer
On Error GoTo SkipVal
Dim l, x, xR, xC As Integer
x = 0
For r = rStart To rEnd
For c = cStart To cEnd
If x < Cells(r, c).Value And used(r - arrR, c - arrC) = False Then
xR = r
xC = c
x = Cells(r, c).Value
End If
Next
Next
used(xR - arrR, xC - arrC) = True
LargeOfRange = x
Exit Function
SkipVal:
LargeOfRange = 0
End Function
Why not just extend the range and add more elements to the Large() calc?
=LARGE(B13:E15,1)+LARGE(B13:E15,2)+LARGE(B13:E15,3)+LARGE(B13:E15,4)+
LARGE(B13:E15,5)+LARGE(B13:E15,6)+LARGE(B13:E15,7)
This returns 80
I am getting an error at the subroutine called NLRegress. I think the array types are not the same that are being multiplied in the first call in Sub NLRegress. The Z matrix is the following array [1,0.2,0.04: 1,0.5,0.25: 1,0.8,0.64: 1,1.2,1.44: 1,1.7,2.89: 1,2,4]
This is my code :
Option Explicit
Option Base 1
Sub Main()
Dim x() As Double, y() As Double, n As Integer, p As Integer, _
a() As Double, syx As Double, r2 As Double, m As Integer, _
yf() As Double, Z() As Double
Dim i As Integer, k As Integer
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
For k = 1 To 100
If Worksheets("Sheet1").Range("B2").Cells(k, 1).Value <> "" Then
p = p + 1 'counts the number of data points
Else
Exit For
End If
Next k
If p = n Then
p = n
ReDim yf(n)
Else: MsgBox ("Unequal number of x and y values")
End If
ReDim x(n)
ReDim y(n)
For i = 1 To n 'Read data for matrix x
x(i) = _
Worksheets("Sheet1").Range("A2").Cells(i, 1).Value
Next
For i = 1 To n 'Read data for matrix y
y(i) = _
Worksheets("Sheet1").Range("B2").Cells(i, 1).Value
Next
m = Worksheets("Sheet1").Range("E2").Value
ReDim a(m + 1)
Call BuildZP(x, Z, n, m)
Call NLRegress(Z, y, a, n, m)
Call MultiplyMatrixByVector(Z, a, yf)
End Sub
Sub Fitted_Data(yf, a, x, n)
Dim q As Integer
For q = 1 To n
yf(q) = a(1) + a(2) * x(q) + a(3) * x(q) ^ 2
Worksheets("Sheet1").Range("C2").Cells(q, 1).Value = yf(q)
Next
End Sub
Sub NLRegress(Z, y, a, n, m)
Dim er As Double, tol As Double, ZT() As Double, ZTZ() As Double, ZTZI() As Double, ZTY() As Double
er = 0
tol = 0.0001
ReDim ZT(m + 1, n)
Call TransposeMatrix(Z, ZT)
Call MultiplyMatrices(ZT, Z, ZTZ)
Call MatrixInverse(ZTZ, ZTZI, m + 1, tol, er)
Call MultiplyMatrixByVector(ZT, y, ZTY)
Call MultiplyMatrixByVector(ZTZI, ZTY, a)
End Sub
Sub BuildZP(x, Z, n, m)
Dim i As Integer, j As Integer
ReDim Z(n, m + 1)
For i = 1 To n
For j = 1 To m + 1
Z(i, j) = x(i) ^ (j - 1)
Next j
Next i
End Sub
This answer will probably not solve your issue (see my comment) - but let me nonetheless give you a few best practices that might make programming in VBA easier and maybe prevent such errors in the first place - in your next project.
Try to incorporate the following into your programming
Proper indenting: Every time you use a programming structure the encloses another block of code - such as For, If, While, indent the enclosed code block one level further. E.g. your first few lines of code should look like
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
You are already using Option Explicit, which is great. However, you should also properly Dim each variable in the procedure/function calls - e.g. Sub Fitted_Data(yf as Double, ...)
You're using a total of 12 variables in your main procedure. This is a very strong indicator, that your routine is doing too much! Better break it up in to small sub routines and maybe use a few module wide variables - see the example below.
The variable names are absolutely meaningless - which makes it hard to debug for you - and almost impossible for outsiders to understand what your code is doing.
AFAIK your first 25 rows "only" assign two ranges to an array and check if these are the same size. Using the syntax x = StartRange.Resize(NumberOfRows).Cells you can achieve this with much less code - and it executes much faster.
Same thing goes finding the first blank row - instead of looping, use StartRange.End(xlDown) - this will return you the last non-blank row!
Also, if you want to assign an array to a range, it works the other way round, too: StartRange.Resize(NumberOfRows) = x.
Hardcoding Worksheets("Sheet1").Range("A2") will lead to problems when the user changes the worksheet structure, e.g. rename the sheet or insert rows/columns. Better assign the cells A2 and B2 names, e.g. StartVector1 and then access them with Range("StartVector1"). Much more robust - and your code is less cluttered
"Don't repeat yourself" (DRY). If you see yourself doing the same code twice, make it a separate procedure - e.g your code to count the number of data points
No need to use Call Sub(x, y) - Sub x, y is equivalent to it in VBA
Excel function can also be used in VBA. This is especially handy for matrix function. E.g. to transpose an array, you could use this code: transposedX = worksheetFunctions.Transpose(x)
Here's the code structure with the first few
Option Explicit
Private mVec1() As Double 'Better give a better name representing the target content of variable
Private mVec2() As Double 'I use m as a prefix to indicate module wide scoped variables
Public Sub SubDoingSomething() 'Use a name that tells the reader what the sub does
LoadVectors
BuildZP Z, n, m 'use proper variable names here
NLRegress Z, y, a, n, m 'and maybe use some more module wide variables that you don't need to pass
MultiplyMatrixByVector Z, a, yf
End Sub
Private Sub LoadVectors()
Dim count1 As Long, count2 As Long
count1 = GetRowLength(Range("StartVector1"))
count2 = GetRowLength(Range("StartVector2"))
If count1 <> count2 Then
MsgBox ("Unequal number of x and y values")
End
End If
mVec1 = Range("StartVector1").Resize(count1).Cells
mVec2 = Range("StartVector2").Resize(count2).Cells
End Sub
Private Function GetRowLenght(rng As Range)
If rng.Offset(1) = "" Then
GetRowLength = 1
Else
GetRowLength = rng.End(xlDown).Row - rng.Row + 1
End If
End Function