I'm trying to get a script working using .FormulaR1C1
Dim blatt As Worksheet
Set blatt = ThisWorkbook.Worksheets("Kurse")
Dim i As Integer
Dim j As Integer
Dim beginn As Integer
Dim schluss As Integer
Dim vlookuprowstart As Integer
Dim vlookuprowend As Integer
Dim referencecolumn As Integer
j = 2
beginn = -1
schluss = 0
For j = 2 To 6597
referencecolumn = 1 - j
i = 5
For i = 5 To 7
vlookuprowstart = 6 - i
vlookuprowend = 64 - i
blatt.Cells(i, j).FormulaR1C1 = "=vlookup($R[0]C[referencecolumn];Aktienkurse!R[vlookuprowstart]C[beginn]:r[vlookuprowend]C[schluss];2;false)"
beginn = beginn + 1
schluss = schluss + 1
i = i + 1
Next i
Next j
However, when trying to execute the FormulaR1C1 command, I get error 1004 - application-defined or object-defined error
Would be great, if somebody could help me. I hope I gave any information necessary.
Germany uses a bit different settings than the standard ones in VBA. Thus , is ; in formulas, . is a , as decimal separator. In your formula, you are using ;, which is not ok.
Best case scenario - write the formula in Excel cell, then select the cell with the mouse.
Then run this code:
Sub RunThis
MsgBox ActiveCell.FormulaR1C1
End Sub
and try to fix the error, by adjusting what you see to your code.
After doing this, start working on this - R[0]C[referencecolumn]. The referencecolumn should be a variable and not a string. E.g., something like this works on an empty worksheet, just to get the idea:
Sub TestMe()
Dim rowEnd As Long
rowEnd = 10
Dim rowStart As Long
rowStart = 1
Range("B1") = "=SUM(R[" & rowStart & "]C[-1]:R[" & rowEnd & "]C[-1])"
End Sub
Examine the formula in "B1" and find a way to modify rowStart and rowEnd to something, that will have more meaning for you.
Related
I'm a beginner of VBA. My problem as title and I really don't know how to correct the code.Below is what I try but I think it's all wrong... Thanks in advance.
Sub Try_Click()
Dim i As Integer
Dim n As Integer
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
For i = 1 To n
i = i * (i + 1)
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = i
End Sub
Don't change i in the loop:
Sub Try_Click()
Dim i As Long
Dim n As Long
Dim prod As Long
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
prod = 1
For i = 1 To n
prod = prod * i
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = prod
End Sub
You need to add another variable to calculate it as below:
Sub Try_Click()
Dim i As Integer
Dim n As Integer
Dim k As Long
k = 1
n = ThisWorkbook.Sheets("Sheet2").Cells(3, 2).Value
For i = 1 To n
k = k * (i)
Next i
ThisWorkbook.Sheets("Sheet2").Cells(5, 2) = k
End Sub
As mentioned in comments, I also would have done:
Option Explicit
Public Sub Try_Click()
Dim n As Long
With ThisWorkbook.Sheets("Sheet 1")
n = .Cells(3, 2)
.Cells(5, 2) = Application.WorksheetFunction.Fact(n)
End With
End Sub
You need an additional variable for the result. Because if you change i within the For loop you fail the auto increment of the loop.
Also I recommend to use Long instead of Integer (for result). Why? Because for n > 7 it will already exceed the limits of Integer and throw an overflow error. Long at least lasts until n = 12. For more you will need to use Double but that will result in an approximated result for n > 18.
Option Explicit
Sub MultiplyN()
Dim i As Long
Dim n As Long
n = 10 'ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
Dim result As Long
result = 1
For i = 1 To n
Debug.Print result & " *" & i & "=" 'look this output in the intermediate window
result = result * i
Next i 'auto increments i
Debug.Print result
'ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = result
End Sub
Note that all Debug.Print lines are not needed to calculate but just to illustrate in the intermediate window what happens.
You can use #SJR suggestion in VBA if you don't want to use formula in cell B5:
=FACT(B3)
Code will be:
Sub Try_Click()
With ThisWorkbook.Sheets("Sheet 1").Cells(5, 2)
.FormulaR1C1 = "=FACT(R[-2]C)"
.Value = .Value
End With
End Sub
I am having problems with the definition of my variables I think but I cannot see where or why. It's quite a simple code to count the amount of lessons teachers have allocated. The information is in the worksheet 'Subects and Teachers 2018' and has to be printed in the worksheet 'Teachers'. The quantities always appear on the left of the name.
Here's the code. If anyone could give me a hint on what I'm defining incorrectly I would be very thankful! Debugging suggests that the problem is in the line which has ***** at the end (not part of the code).
Sub Counter2018()
Dim Var1 As String
Dim CVar1 As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
For k = 2 To 50
Var1 = Worksheets("Teachers").Cells(k, 3)
CVar1 = 0
For i = 2 To 45
For j = 2 To 45
If Worksheets("2018 Subjects and Teachers").Cells(i, j) = Var1 Then
CVar1 = CVar1 + Worksheets("2018 Subjects and Teachers").Cells(i, j - 1) *****
End If
Next j
Next i
Worksheets("Teachers").Cells(k, 5) = CVar1
Next k
End Sub
Try this version (untested)
Option Explicit
Public Sub Counter2018()
Dim wsTeachers As Worksheet, wsSubjects As Worksheet
Set wsTeachers = Worksheets("Teachers")
Set wsSubjects = Worksheets("2018 Subjects and Teachers")
Dim teacher As String, counter As Long
Dim i As Long, j As Long, k As Long
For k = 2 To 50
teacher = wsTeachers.Cells(k, 3)
counter = 0
For i = 2 To 45
For j = 2 To 45
If wsSubjects.Cells(i, j).Value2 = teacher Then
If Not IsError(wsSubjects.Cells(i, j - 1)) Then
counter = counter + Val(wsSubjects.Cells(i, j - 1).Value2)
End If
End If
Next
Next
wsTeachers.Cells(k, 5) = counter
Next
End Sub
I think the Type Mismatch error is caused by some of the cells in wsSubjects.Cells(i, j - 1)
That counter expects numbers in that column, but there might be some strings or errors in there
I'm new to Excel VBA and this is my first macro, so please forgive me if I've made a very obvious mistake. I have the following code to compare to worksheets and, if a match is found, to make a note on one of the sheets. It runs with no errors, but the changes are not being made. I can't see where I've gone wrong. Thanks in advance for the help.
Sub invalid()
Dim i As Integer
Dim j As Integer
Dim main As Worksheet
Dim invalid As Worksheet
i = 2
Set main = ThisWorkbook.Worksheets(1)
Set invalid = ThisWorkbook.Worksheets(2)
Do
j = 2
Do
If LCase$(invalid.Cells(i, 1).Value) = LCase$(main.Cells(j, 13).Value) Then
main.Cells(j, 14).Value = "Invalid Email"
End If
j = j + 1
Loop While main.Cells(j, 2) = Not Null
i = i + 1
Loop While invalid.Cells(i, 2) = Not Null
End Sub
Try this, it removes one of the loops:
Sub invalid()
Dim i As Long
Dim j As Long
Dim lRow As Long
Dim main As Worksheet
Dim invalid As Worksheet
Set main = ThisWorkbook.Worksheets(1)
Set invalid = ThisWorkbook.Worksheets(2)
lRow = main.Cells(main.Rows.Count, 13).End(xlUp).Row
For i = 2 To lRow
j = 0
On Error Resume Next
j = Application.WorksheetFunction.Match(main.Cells(i, 13), invalid.Range("A:A"), 0)
On Error GoTo 0
If j > 0 Then main.Cells(i, 14) = "Invalid Email"
Next i
End Sub
This the code I am trying to run:
Option Explicit
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i, j, l, d, k, count As Integer
Dim custID(), amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To FinalRow
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
'-------------Match it and present the output----
l = 4
Dim wk As Worksheet
Set wk = Sheets("Results")
With wk
For j = 0 To FinalRow
Sum = amtPur(j)
'For the first iteration
If j = 0 Then
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & 3).Value = custID(j).Value
wk.Range("B" & 3).Value = Sum
Else: End If
'For the rest iterations
count = 0
d = j
Do While (d >= 0)
If custID(d) = custID(j) Then
count = count + 1
Else: End If
d = d - 1
Loop
If count <= 1 Then 'Check if instance was already found
For k = j + 1 To FinalRow
If custID(j) = custID(k) Then
Sum = amtPur(k) + Sum
Else: End If
Next k
wk.Range("A" & l).Value = custID(j).Text
wk.Range("B" & l).Value = Sum
l = l + 1
End If
Next j
End With
End Sub
but unfortunately am getting:
Subscript out of Range - Run time error 9
when I try to run it.
While you have declared your custID() and amtPur() arrays, they need to be initialised using ReDim statements before you can use them. In your case you will want to ReDim Preserve to retain values already stored in the arrays during prior loops:
Sub Test()
'-------------Declarations-------------------
Dim FinalRow, Sum As Long
Dim i As Integer
j As Integer
l As Integer
d As Integer
k As Integer
count As Integer
Dim custID() As Long, amtPur() As Long
Dim ws As Worksheet
Set ws = Sheets("Data")
FinalRow = ws.Range("B90000").End(xlUp).Row
j = 0
'-------------Get All the Data-------------------
With ws
For i = 4 To 100
ReDim Preserve custID(0 To j)
ReDim Preserve amtPur(0 To j)
custID(j) = ws.Range("B" & i).Value 'Error Here
amtPur(j) = ws.Range("C" & i).Value 'Error Here
j = j + 1
Next i
End With
End Sub
Hmm, seems a little harsh that this question has been downvoted. You're clearly new to VBA and it does seem that you've given this a fair go. I admire people who learn through trial and error - it's certainly more than many first posters do - so I'd like to give you a pretty full answer with a bit of the theory behind it:
Dim - as mentioned, declare each type. Avoid names that are similar to existing functions, like sum.
If you declare your 'read' variable as a variant, you can read the data from the worksheet with just one line and the array will be dimensioned for you. You can also acquire custID and amtPur in the same array. I've given you an example of this in the code below in a variable called custData. Be aware that these arrays have a base of 1 rather than 0.
Your With blocks are redundant. These are meant to save you repeating the object each time you access its properties. In your code you repeat the object. I'm not a huge fan of With blocks but I've put a sample in your code so you can see how it works.
Your If ... Else ... End If blocks are a bit muddled. The logic should be If (case is true) Then do some code Else case is false, so do some other code End If. Again, I've tried to re-write your code to give you examples of this.
You are confusing looping through a Range and looping through an Array. In your code you have set the limits of the Range as 4 - FinalRow. However, this does not mean your arrays have been set to the same dimensions. Most likely, your arrays start from 0 and go to FinalRow - 4. You need to be clear about these dimensions before looping.
As Mark Fitzgerald mentions, you need to dimension your array before using it. If it's an initial dimension then you could just use Redim. If you want to increase the array's dimension whilst retaining existing values then use Redim Preserve. I've tried to give you an example of both in the code below.
Okay, so onto your code...
With the looping, array size and If mistakes, it's rather difficult to see what you're trying to do. I think you might be trying to read all the customer IDs, writing them into a unique list and then summing all the values that match each ID. The code below does that. It's not the quickest or best way, but I've tried to write the code so that you can see how each of the errors above should work. I guess it doesn't matter if I'm up the wrong path as the main aim is to give you an idea of how to manage arrays, loops and Ifs. I hope your custID and amtPur are genuinely Longs - if, for example, amtPur stands for 'amount purchased' and is, in fact, a decimal number then this code will throw and error, so make sure your values and declarations are of the same type. Your commenting etiquette is a little esoteric but I've still followed it.
Good luck with your project and keep at it. I hope this helps you:
'-------------Declarations-------------------
Dim dataSht As Worksheet
Dim resultsSht As Worksheet
Dim custData As Variant
Dim uniqueIDs() As Long
Dim summaryData() As Long
Dim counter As Integer
Dim isUnique As Boolean
Dim rng As Range
Dim i As Integer
Dim j As Integer
'-------------Get All the Data-------------------
Set dataSht = ThisWorkbook.Sheets("Data")
Set resultsSht = ThisWorkbook.Sheets("Results")
With dataSht
Set rng = .Range(.Cells(4, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Resize(, 2)
End With
custData = rng.Value2 'writes worksheet to variant array
'-------------Loop through the data to find number of unique IDs----
For i = 1 To UBound(custData, 1)
isUnique = True
If i = 1 Then
'First iteration so set the counter
counter = 0
Else
'Subsequent iterations so check for duplicate ID
For j = 1 To counter
If uniqueIDs(j) = custData(i, 1) Then
isUnique = False
Exit For
End If
Next
End If
'Add the unique ID to our list
If isUnique Then
counter = counter + 1
ReDim Preserve uniqueIDs(1 To counter)
uniqueIDs(counter) = custData(i, 1)
End If
Next
'-------------Aggregate the amtPur values----
ReDim summaryData(1 To counter, 1 To 2)
For i = 1 To counter
summaryData(i, 1) = uniqueIDs(i)
'Loop through the data to sum the values for the customer ID
For j = 1 To UBound(custData, 1)
If custData(j, 1) = uniqueIDs(i) Then
summaryData(i, 2) = summaryData(i, 2) + custData(j, 2)
End If
Next
Next
'-----------Outpute the results to the worksheet----
Set rng = resultsSht.Cells(4, 1).Resize(counter, 2)
rng.Value = summaryData
the code below is part of a larger Macro, all variables have been specified earlier on but this is the part i'm having the problem with. it's basically meant to loop through a column of company Names and for each company, add up all charges to that company listed on another workbook (essentially like a cost summary for each). Everything seems to work fine except the two rows with ** next to them, here im getting the "Invalid Procedure Call or argument" error and im not sure why. This particular section is meant to compare only the first word in a company name on each workbook (this means different branches are also summed up for a head office total, e.g. so "Company x Group" would include "Company x Manchester" and "Company x London" in its total).
I've tested the two problematic lines in a smaller test macro to see if it actually does represent the first word of the string and it works fine but when i try to use it in this larger macro this is the part that stops it working.
I'm very new to VBA so i understand if the code is a bit clunky and messy but any help would be greatly appreciated. Also apologies for the long winded explanation.
Thanks in Advance!
(the "If Not" part is so only companies that have had sales in this particular week but do not have an amount next to it are taken through the extra loop i.e. "number of sales" isn't empty but "money made" is 0)
Dim AgeName As Range
Dim AgeNameB As Range
Dim AgeNameAdd As String
Dim Lrow As Long
Dim J As Integer
Dim K As Double
Dim PostingRange As Range
Dim Postingaddress As String
Dim MarginValueBook As String
Dim MarginValueSheet As String
Dim WENum As String
Dim Postinglocation As Range
Dim L As Integer
Dim M As Double
Dim FirstNameAgeA As String
Dim FirstNameAgeB As String
Dim WENumb As String
Dim AgeComparison As String
Dim FirstWordArrA As String
Dim FirstWordArrB As String
MarginValueBook = "W.E. " & Format(dtTestDate, "DD.MM") & ".csv"
MarginValueSheet = "W.E. " & Format(dtTestDate, "DD.MM")
For i = 2 To y
K = 0
Workbooks("Average Margin Data.xlsm").Activate
Set ws = ThisWorkbook.Worksheets("Breakdown")
Set AgeName = ws.Range(celladdress).Offset(i)
AgeNameAdd = AgeName.Address
Set PostingRange = Range(AgeNameAdd).Offset(0, 3)
Postingaddress = PostingRange.Address
Workbooks(MarginValueBook).Activate
Set ws = Worksheets(MarginValueSheet)
Lrow = ActiveSheet.UsedRange.Rows.Count
For J = 2 To Lrow
WENum = "A" & J
If ws.Range(WENum) = UCase(AgeName) Then
K = K + ws.Range(WENum).Offset(0, 4).Value
End If
Next J
Set Postinglocation = Range(Postingaddress).Resize(1, 1)
Postinglocation.Value = K
Set ws = ThisWorkbook.Worksheets("Breakdown")
If Not ws.Range(AgeNameAdd).Offset(0, 2) = "" Then
If ws.Range(AgeNameAdd).Offset(0, 3) = 0 Then
For L = 2 To Lrow
Set AgeName = ws.Range(celladdress).Offset(i)
FirstWordArrA = AgeName.Value
'FirstNameAgeA = Trim$(Left$(FirstWordArrA, InStr(FirstWordArrA, " ") - 1))
AgeComparison = UCase(FirstNameAgeA)
Set wb = Workbooks(MarginValueBook)
Set ws = wb.Worksheets(MarginValueSheet)
WENumb = "A" & L
Set AgeNameB = ws.Range(WENumb)
FirstWordArrB = AgeNameB.Value
'FirstNameAgeB = Trim$(Left$(FirstWordArrB, InStr(FirstWordArrB, " ") - 1))
If AgeComparison = FirstNameAgeB Then
M = M + ws.Range(WENumb).Offset(0, 4).Value
End If
Next L
Set Postinglocation = Range(Postingaddress).Resize(1, 1)
Postinglocation.Value = M
M = 0
End If
End If
Next i
End Sub
Look at the InStr values. Someone might be null. Try to put a onError statement in order to return the correct value.