Someone helped me out with code for VBA in Excel. My code is as follows:
Sub VidyaGames()
Dim LastRow As Variant, j As Integer
LastRow = Range("A65536").End(xlUp).Address
j = 2
For i = 1 To Range("A1", LastRow).Rows.Count + 1 Step 10
Worksheets("Sheet1").Cells(j, 1) = Worksheets("PlayerInfoAll").Cells(i, 2)
Worksheets("Sheet1").Cells(j, 2) = Worksheets("PlayerInfoAll").Cells(i + 1, 2)
Worksheets("Sheet1").Cells(j, 3) = Application.WorksheetFunction.Sum(Worksheets("PlayerInfoAll").Range(Cells(i + 3, 1), Cells(i + 3, 1).End(xlToRight)))
Worksheets("Sheet1").Cells(j, 4) = Application.WorksheetFunction.Sum(Worksheets("PlayerInfoAll").Range(Cells(i + 4, 1), Cells(i + 4, 1).End(xlToRight)))
Worksheets("Sheet1").Cells(j, 5) = Worksheets("PlayerInfoAll").Cells(i + 5, 2)
Worksheets("Sheet1").Cells(j, 6) = Worksheets("PlayerInfoAll").Cells(i + 6, 2)
Worksheets("Sheet1").Cells(j, 7) = Worksheets("PlayerInfoAll").Cells(i + 7, 2)
Worksheets("Sheet1").Cells(j, 8) = Worksheets("PlayerInfoAll").Cells(i + 8, 2)
Try
Worksheets("Sheet1").Cells(j, 9) = Application.WorksheetFunction.IsNA ((Application.WorksheetFunction.Match(730, Worksheets("PlayerInfoAll").Range(Cells(i + 2, 1), Cells(i + 2, 1).End(xlToRight)), 0)))
Catch
Worksheets("Sheet1").Cells(j, 9) = 0
j = j + 1
Next i
End Sub
The code takes data from "Blocks" in one sheet and puts them into a readable/SPSS-like format in another sheet. I added the Try and Catch code at the bottom, but it doesn't seem to be working. If i run the line without the Try and Catch line, the code will terminate when it finds a row that does NOT contain the identifier ("730"). I looked up try and catch, thinking it was like Python's try and except but when I try to run it i get the message "Compile error: Sub or function not defined" and Try is highlighted.
Does Try/Catch work like Python's Try/Except? If so, how do I get it to work here?
While VBA has no such thing as a Try/Catch block you could use standard Error Handling for this such as
Sub VidyaGames()
For i = 1 To Range("A1", LastRow).Rows.Count + 1 Step 10
....
Worksheets("Sheet1").Cells(j, 9) = TryCatchWorkAround(i)
j = j + 1
Next i
End Sub
Private Function TryCatchWorkAround(i AS Integer) AS Integer
On Error GoTo Handler
TryCatchWorkAround = Application.WorksheetFunction.IsNA ((Application.WorksheetFunction.Match(730, Worksheets("PlayerInfoAll").Range(Cells(i + 2, 1), Cells(i + 2, 1).End(xlToRight)), 0)))
Exit_TryCatchWorkAround:
Exit Function
Handler:
TryCatchWorkAround = 0
Resume Exit_TryCatchWorkAround
End Function
This will perform the same function just using VBA Standard Error Handling.
VBA does not offer try/catch blocks. You could try modifying error handling by using On Error Goto xxx where xxx is a label where your error handling code resides. Look up On Error Goto ... on the internet for more information.
Related
This question already has an answer here:
Application.Match gives type mismatch
(1 answer)
Closed 4 years ago.
I want to check for two conditions:
If Tabelle3.Cells(7 + i, 1) <> ""
If the Tabelle3.Cells(7 + i, 1) can be found in Tabelle8.Range("A:A")
In case one of them is not fulfilled I want it to jump to the next i.
Therefore, I'm using Application.Match for the second condition and the code is the following:
If Tabelle3.Cells(7 + i, 1) <> "" And Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) Then
But the Run-Time Error '13' "Types Incompatible" occurs. Does someone know why and how I can make this one work? :)
Below the whole code:
Sub Test()
Dim lastrow2 As Long
lastrow2 = Tabelle3.Range("A" & Rows.Count).End(xlUp).Row
Set myrange2 = Tabelle8.UsedRange
For i = 2 To lastrow2
If Tabelle3.Cells(7 + i, 1) <> "" And Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) Then
Tabelle3.Cells(7 + i, 19) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 3, False)
Tabelle3.Cells(7 + i, 20) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 4, False)
End If
Next i
End Sub
Run this code:
Sub TestMe()
Debug.Print CBool(Application.Match("Something", Range("A:A"), False))
End Sub
It prints True on the immediate window, although there is no string "Something" on the first column of your worksheet. Thus in your case, Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) will always be evaluated to True and this is not how it should be.
Consider some check for errors like IsError(Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False)), which would be True, in case that the value cannot be found.
Sub project()
Dim a, deltat_value1, deltat_value2, deltat_value3 As Integer
a = 2
Do
deltat_value1 = Cells(a, 7).Value
deltat_value2 = Cells(a + 1, 7).Value
deltat_value3 = Cells(a + 2, 7).Value
If Abs(deltat_value1 - deltat_value2) > 5 And Abs(deltat_value2 - deltat_value3) > 5 Then
Rows(a + 1).EntireRow.Delete
End If
a = a + 1
Loop Until deltat_value1 = 14700
End Sub
I am trying to delete the noisy data, I set if a data point that it has a difference bigger than 5 from both the points above and below it, that is a noisy data and I set to delete the whole row of the noisy data.
However, I am having this problem for the line:
deltat_value3=Cells(a+2,7).Value
Runtime Error 1004 "Application-defined or Object-defined error"
And the running takes extremely longer time. I am a new user of VBA programming and I think my method may be inefficient, there may be other ways work much better, any advice?
How about:
Sub ytrewq()
Dim a As Long, deltat_value1 As Long, deltat_value2 As Long, deltat_value3 As Long
Dim rKill As Range
a = 2
Do
deltat_value1 = Cells(a, 7).Value
deltat_value2 = Cells(a + 1, 7).Value
deltat_value3 = Cells(a + 2, 7).Value
If Abs(deltat_value1 - deltat_value2) > 5 And Abs(deltat_value2 - deltat_value3) > 5 Then
If rKill Is Nothing Then
Set rKill = Cells(a + 1, 1)
Else
Set rKill = Union(rKill, Cells(a + 1, 1))
End If
End If
a = a + 1
Loop Until deltat_value1 = 14700
rKill.EntireRow.Delete
End Sub
I can't figure out what is the mistake I am making in this code. The error is on setting up the range (line 3 on last loop). Any help would be appreciated. I have lots of code here but i believe all of it is good except in the last loop around p it gives me an error about the range function I believe.
For p = 1 To 100
If ActiveWorkbook.Worksheets(1).Cells(p + 26, 10).Value = Sheet3.Cells(6 + k, 4).Value Then
Set rng = Sheet3.Range(Cells(k + 6, 5), Cells(k + 6, 12))
lAnswer = Application.WorksheetFunction.Sum(rng)
ActiveWorkbook.Worksheets(1).Cells(p + 27, 13).Value = lAnswer
k = k + 1
End If
Next p
End If
Next t
End Sub
You must qualify both Range and Cells with the worksheet:
Set rng = Sheet3.Range(Sheet3.Cells(k + 6, 5), Sheet3.Cells(k + 6, 12))
Ok so I'm definitely a novice at VBA but I'm learning. As far as I can tell there no reason my code shouldn't be running fine, and has in the past. This error keeps popping up though. What the intention is I'm making a sheet that automatically updates the other sheets when you add a person to the main sheet. The code seems to work and has, but it is suddenly throwing this error and I can't figure out why. I've looked around but none of the solutions seem to be remotely relevant to my issue. Any help at figuring out exactly where the error is would be greatly appreciated!
The following is where the debugger is saying the error is:
Private Sub Worksheet_Activate()
ThisWorkbook.UpdateSheets (Week2)
End sub
And this is the function being called:
Public Function UpdateSheets(ByRef w As Worksheet)
HowManyPeople
With w
.Columns("A:W").HorizontalAlignment = xlCenter
Dim i As Integer
Dim j As Integer
For i = 1 To x
If IsEmpty(.Cells(i, 2)) Then
For j = 2 To 12
.Cells(i + 4, j).Borders.LineStyle = xlContinuous
If j <> 12 Then
.Cells(i + 4, j).Interior.ColorIndex = 2
.Cells(i + 4, j).Locked = False
Else
.Cells(i + 4, j).Interior.ColorIndex = 15
.Cells(i + 4, j).Locked = True
End If
If j = 2 Then
.Cells(i + 4, j).Value = Week1.Cells(i + 4, j)
Else
.Cells(i + 4, j).Value = "0"
End If
Next j
End If
Next i
i = x + 5
Do
For j = 2 To 12
.Cells(i, j).Borders.LineStyle = xlNone
.Cells(i, j).Interior.ColorIndex = 2
.Cells(i, j).Locked = True
.Cells(i, j).Value = ""
Next j
i = i + 1
Loop Until IsEmpty(.Cells(i, j))
End With
End Function
the function HowManyPeople is a basic row counting method. x is a public workbook variable given value in the HowManyPeople method. Week1 and Week2 are the technical names (not displayed name) of the worksheets
Solution
In the sub, change this :
ThisWorkbook.UpdateSheets (Week2)
to this
Call UpdateSheets(ThisWorkbook.Worksheets("Week2"))
Explanation of the problem
See similar question on SO
There is no UpdateSheets member of ThisWorkbook object.
My function looks like this:
Sub sortNumbers()
Dim i As Integer
Dim j As Integer
Dim highestNumber As Integer
For i = 1 To 8
If IsEmpty(Cells(i + 4, 6).Value) = False Then
If Cells(i + 3, 6).Value > Cells(i + 4, 6).Value Then
highestNumber = Cells(i + 3, 6).Value
Cells(i + 3, 6).Value = Cells(i + 4, 6).Value
Cells(i + 4, 6).Value = highestNumber
End If
End If
Next i
For j = 1 To 8
If IsEmpty(Cells(j + 4, 6).Value) = False Then
If Cells(i + 3, 6).Value > Cells(i + 4, 6).Value Then
Call sortNumbers
Else
Exit Sub
End If
End If
Next j
End Sub
Everything gets sorted properly, but right after I get a message saying Out of stack space
Any help would be much appreciated!
EDIT
The excel sample data looks like this:
test data
1
100
1000
8
9
9
50
100
500
(from F3-F12)
If you remove the IsEmpty lines, Empty cells will be treated as 0. If you wish to leave them blank and sort around them you will need to impliment additional logic.
Your second loop needed to be adjusted. As it stood, the first time
call 1:
The first loop would give:
1 100 8 9 9 50 100 500 1000
Then the second loop would get to 1 > 100 and exit sub.
BUT... its best not to simply remove the exit sub call.
Its more efficient to only recall sortNumbers once per call.
If you had simply removed the exit sub.
then the second loop would get to 100 > 8 and trigger a recursion (Call 2).
Call 2:
the first loop would give:
1 8 9 9 50 100 100 500 1000
then the second loop would determine that Cells(i + 3,6) is never > Cells(i + 4,6) and exit Sub.
Since the 2nd call has returned we resume Call 1 where we left off. This means we finish the 2nd loop.
If this were a larger dataset you could have hundreds of recursions required to sort the dataset. When the last call (lets say its the 104th call) returns the previous 103 calls to the routine would all finish their 2nd loops (which since the 104th call returned, the data is already sorted, and thus is a waste)
The second loop should simply check to see if a recall is nessisary and if so, recall sortNumbers one time.
Sub sortNumbers()
Dim i As Integer
Dim j As Integer
Dim highestNumber As Integer
For i = 1 To 8
If Cells(i + 3, 6).value > Cells(i + 4, 6).value Then
highestNumber = Cells(i + 3, 6).value
Cells(i + 3, 6).value = Cells(i + 4, 6).value
Cells(i + 4, 6).value = highestNumber
End If
Next i
Dim ReCall As Boolean
ReCall = False
For i = 1 To 8
If Cells(i + 3, 6).value > Cells(i + 4, 6).value Then
ReCall = True
i = 8
End If
Next i
If ReCall Then Call sortNumbers
End Sub