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))
Related
I am organizing a dirty text in an organised table. And this code stops when the cell the marked line is completed. Can you help me to make it continuing the loop?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim sh7 As Worksheet
Dim CNAME As String
Set sh = Worksheets("Sheet6")
Set sh7 = Worksheets("Sheet7")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To lr
If InStr(1, sh.Cells(n, 1), "CALL:") = 1 Then
CNAME = sh.Cells(n, 7).Value
Ci = sh.Cells(n + 1, 7).Value
Cpd = sh.Cells(n + 1, 7).Value
Else
If InStr(1, sh.Cells(n, 1), "Topic:") = 1 Then
T = sh.Cells(n, 2)
Tpd = sh.Cells(n + 1, 2)
Types = sh.Cells(n + 4, 2)
DM = sh.Cells(n + 5, 2)
D = sh.Cells(n + 5, 4)
OD = sh.Cells(n + 6, 2)
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
sh7.Cells(lr7 + 1, 1).Value = CNAME '********This is the last line it runs.
sh7.Cells(lr7 + 1, 2).Value = Ci
sh7.Cells(lr7 + 1, 3).Value = Cpd
sh7.Cells(lr7 + 1, 4).Value = T
sh7.Cells(lr7 + 1, 5).Value = Tpd
sh7.Cells(lr7 + 1, 6).Value = Types
sh7.Cells(lr7 + 1, 7).Value = DM
sh7.Cells(lr7 + 1, 8).Value = D
sh7.Cells(lr7 + 1, 9).Value = OD
End If
End If
Next n
End Sub
You should get in the habit of defining all variables and supplying a default value.
EDIT:
It seems my original conclusion was incorrect. Upon further inspection I see what might be an issue in your code. Both times where you are trying to get the last row, you are using Rows.Count as a parameter.
Maybe change these
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
To this (note that I use the sheet variable in the first param)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(sh7.Rows.Count, 1).End(xlUp).Row
I'm trying to run a For Next Loop until the last row of a specific column (but not the last row of the sheet). So the first part of my list has data in column F and the second part doesn't. I only want the macro to apply to that first part. For some reason the loop only runs through the first part with certain commands but doesn't with the ones I am trying to do now. (I know it would be easy just to seperate the two parts manually and then run it but it drives me nuts not knowing what it is I did wrong :)).
This is the code:
Dim i As Integer
Dim g As Double
g = 0.083333333
Dim lastrow As Long
lastrow = Sheets("zm").Range("f" & Rows.Count).End(xlUp).Row
Sheets("zm").Activate
For i = 2 To lastrow
If Sheets("zm").Cells(i, 1) = Sheets("zm").Cells(i + 1, 1) And Sheets("zm").Cells(i, 5) = Sheets("zm").Cells(i + 1, 5) And Sheets("zm").Cells(i + 1, 6) - Sheets("zm").Cells(i, 7) < g Then
Sheets("zm").Cells(i + 1, 7).Copy
Sheets("zm").Cells(i, 7).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("zm").Rows(i + 1).Delete
End If
Next i
Thanks for your help!
avoid Select/Selection and/or Activate/ActiveXXX
try this:
Option Explicit
Sub main()
Dim i As Long, lastrow As Long
Dim g As Double
g = 0.083333333
With Worksheets("zm")
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = lastrow To 2 Step -1
If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 5) = .Cells(i + 1, 5) And .Cells(i + 1, 6) - .Cells(i, 7) < g Then
.Cells(i + 1, 7).Copy Destination:=.Cells(i, 7)
.Rows(i + 1).Delete
End If
Next i
End With
End Sub
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
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.
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.