looping through rows and adding values - excel

Here is my code
With Worksheets("Sheet1")
For x = 5 To x = 30 Step 1
Set addRange1 = .Range(.Cells(x, 4), .Cells(x, myCount2))
cell(x, myCount2 + 2).Value = Application.Sum(addRange1)
Next
End With
First row would be cell(5,4) to cell(5, 20) or something. Sum the values of that row and display it in cell (5,22)
Repeat up to x = 30
Hope that is clear
Getting blank cells where sum value should be

This would be correct:
With Worksheets("Sheet1")
For x = 5 To 30
Set addRange1 = .Range(.Cells(x, 4), .Cells(x, myCount2))
Cells(x, myCount2 + 2).Value = Application.Sum(addRange1)
Next
End With
The For ... Next was incorrect. Instead of To x = 30 it has to be To 30.
Info what happened here: If you walked through your code step-by-step you would have noticed that everything inside your For ... Next is never executed. This is because x = 30 in the For sets x to the value 30 and this is the end of the For so the For gets never executed.
The Step 1 isn't necessary, it is 1 by default you may remove it or keep it but it is not necessary.
And as Darren Bartrup-Cook mentioned it has to be Cells instead of Cell.

Related

Can't switch row after specific line number

I'm pretty new to programming,and I have a university task where I'm need to calculate if person have more than 40 hours in week,If Yes then In row(H3:K3) need to be written about that.(each cell=1 week)
But I dont know how to change row after reaching K3 position.
So I only can check one person out of 5.
Please can somebody help me with that..
Thanks
Screenshot
VBA
Sub ssda()
x=3
i=2
j=8
Do
x=x+1
For i = 2 To 5
if Cells(x, i) > 40 Then
Cells(x, j) = "Ir parstrade"
j = j + 1
Else
Cells(x, j) = "Nav parstrades"
j = j + 1
End If
Next
Loop Until x=x+1
End Sub
Im need to all 5 persons have answer if they worked more than 40 hours.
It need to take numbers from cell(B3:D3) if there is more than 40,then In row(H3:K3) should be "Good" otherwise "Bad",afther that need to check next person.
This is untested, but I think it should be right:
First of all, you would have to reset j to 8 for each person.
But you can also use .Offset from a cell (6 cells to the right from each number), this seems easier to me.
Sub ssda()
x=3
' i=2 not needed
' j=8 wrong here
Do
' x=x+1 wrong here, if you want to start in row 3, not 4,
' in the first round. Put this at the end of the loop
' j = 8 would be ok here
For i = 2 To 5
if Cells(x, i) > 40 Then
'Cells(x, j) = "Ir parstrade"
' alternative: just use offset
Cells(x, i).Offset(0, 6) = "Ir parstrade"
Else
Cells(x, i).Offset(0, 6) = "Nav parstrades"
'Cells(x, j) = "Nav parstrades"
End If
j = j + 1
Next
x = x + 1
'Loop Until x=x+1 - this can never be true
Loop Until Cells(x, 1) = ""
End Sub

How can I effectively use If statements with multiple conditions in VBA, comparing user input to a range?

I am attempting to create an Auto-grading test of sorts in Excel.
I have 5 values in Sheet1 that are input by a user in cells E5:E9. These should then be compared against a range of 5 more cells in Sheet2 (also cells E5:E9).
As the user might not always list these entries in the same order that I have in my Sheet2 range, I decided that I should loop through the range for each cell's input.
The next step would be to be able to ignore the value in the range once a match has been found but I need to get this part working correctly. Currently, the values absolutely match. However, I am not getting the correct output.
Sub Q1()
Dim i As Integer
For i = 5 To 9
If (Sheet1.Cells(5, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(6, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(7, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(8, 5) = Sheet2.Cells(i, 5)) And (Sheet1.Cells(9, 5) = Sheet2.Cells(i, 5)) Then
Sheet1.Cells(5, 6) = 1
Exit For
Else
Sheet1.Cells(5, 6) = 0
End If
Next
End Sub
I would expect the output of 1 to Sheet1 cell E6 but I am currently getting 0. Thanks!
Little Complex :)
Sub Q1()
Dim i As Integer
Dim j As Integer
Dim chck(5 To 9) As Boolean
For i = 5 To 9
For j = 5 To 9
If Sheet1.Cells(i, 5) = Sheet2.Cells(j, 5) Then
chck(i) = True
Exit For
Else: chck(i) = False
End If
Next
Next
j = 0
For i = LBound(chck) To UBound(chck)
If chck(i) = True Then j = j + 1
Next
If j = 5 Then
Sheet1.Cells(5, 6) = 1
Else: Sheet1.Cells(5, 6) = 0
End If
End Sub
Does this really need to be VBA? A formula can perform this calculation. Use this in 'Sheet1' cell F5:
=--(SUMPRODUCT(COUNTIF(Sheet2!E5:E9,E5:E9))>0)
If at least one of the values in 'Sheet1'!E5:E9 (the user entered values) exists in your 'Sheet2'!E5:E9 list, the formula will return a 1 else 0 which is the desired result based on your description.

Type Mismatch error adding 10 Seconds to the previous cell's value

I would like to write to a cell the previous cells time value + 10 seconds.
I have tried several approaches after a lot of googling, however below is what I started with and what I would like to understand is why this doesn't work - as in my head it is logical.
The cell data is in the special format DD:MM:YYYY HH:MM:SS - which is a reason this may not work, however if I add + (10 / (3600 * 24)) to the cell manually then it successfully adds on 10 seconds.
Dates are stored as custom and show up as 24/09/2018 08:41:09.
Public Sub Add_Row()
Dim Row As Variant
Dim LR As Long
Dim x As Integer
Dim y As Integer
LR = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'Counts number of rows
x = 1
Row = 1
Do Until x = LR
If Cells(Row, 2).Value <= 1 Then 'If the value of the cell is less than or equal to one do nothing and increment
Row = Row + 1
x = x + 1
Else
y = Cells(Row, 2).Value - 1 'Need a variable for the number of rows we require based on how many missed points we have
For k = 1 To y
ActiveSheet.Rows(Row).Insert Shift:=xlDown
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + (10 / (3600 * 24))
Next
Row = Row + y + 1
x = x + 1
End If
Loop
End Sub
MUltiplying 3600 by 24 in VBA will give an overflow error, because the max value of a 16 bit integer (the default type for the result when both the input numbers are integers) is 32767. You can either use a "#" which will tell VBA that you want to treat the result as a double, like so:
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + (10 / (3600# * 24))
OR you can use "#12:00:10 AM#" which represents 10 seconds, rather than attempting to calculate it, like so:
Cells(Row, 1).Value = Cells(Row - 1, 1).Value + #12:00:10 AM#
Hope this helps.

Find next ocurrence of values - COUNTIF is too slow

I'm trying to speed up a COUNTIFS formula in a table I have.
The table is over 60k rows and the COUNTIFS has three conditions. The formula right now looks like this:
=IF(AND(COUNTIFS([Vessel],[#Vessel],[Date],">"&[#Date],[ETA],"<="&[#ETA]+20)=0,[#Arrived]=1,[#Sailed]=1,[#Date]<MAX([Date])),1,0)
The problem is that the calculation takes a very long time and it triggers everytime something change, even the filter. I don't want to turn calculations to manual in this sheet.
The purpose of the formula is to find the next occurence of the vessel in the line, the ETA can be slightly changed from day to day or the same ship can appear months later. I need to confirm if the vessel appears with the same ETA (or up to 20 days of difference) on another day.
Is there any other solution to this problem?
Maybe try building this as a macro instead, that way you would have control over when it executes.
Here is a start on a method for doing this. It gets the job done but breaks on an error on/after the last line is processed. Edit : Fixed and tested
Public Sub shipcheck()
Application.ScreenUpdating = False
Dim x As Long
Dim y As String
Dim counter As Long
For x = 2 To Range("A85536").End(xlUp).Row ' Assuming data has headers
y = Cells(x, 1) ' This assumes your vessel is in the first column
counter = x + 1
Do
If cells(counter,1) = "" Then Exit Do
If y = Cells(counter, 1) Then
If Cells(x, 2) <> Cells(counter, 2) Then 'This assumes your date is the second column
If DateDiff("d", Cells(x, 3), Cells(counter, 3)) > 20 Then ' this assumes ETA is your third column
Cells(x, 4) = 1 'This assumes the positive test is the fourth column
Cells(counter, 4) = 1
Exit Do
Else
End If
Else
End If
Else
End If
counter = counter + 1
Loop
Next x
Application.ScreenUpdating = True
End Sub

Filling Array once worked, does not anymore (subscript out of range)

The code I have once worked to add/delete groups of rows (requirements). I needed to modify the code so that if the 1st row of the group met certain criteria (i.e, the requirement was not one we wanted to consider), (1) we would not count it and (2), we would hide the group (current and subsequent 2 rows). This all works fine.
The problem is that now that I incorporated these changes, I get an error in another section of the code and for the life of me I cannot figure out why. I have stepped through this and am extremely frustrated. I am reaching out for help, and am hoping someone can see my error(!)
We calculate the start and finish row numbers within a grouping, and store these calculations in Arrays called "Start" and "Finish." I use the ReDim statement to initialize my arrays, because I thought that could be part of the problem, but no.
Any insight as to why my "subscripts are out of range" would be appreciated. I have traced through the logic, investigated this error, and read about the syntax/usage of VBA arrays. I don't know what else to do. Thanks in advance. Here are the relevant lines:
Sub Button1_Click()
Cells.Select
Selection.ClearOutline
If Cells.EntireRow.Hidden Then Cells.EntireRow.Hidden = False
Dim Start() As Integer
Dim Finish() As Integer
Dim p As Integer, q As Integer
ReDim Start(0, 50)
ReDim Finish(0, 50)
The following is embedded in logic that loops through all the rows in the spreadsheet:
i = 1
For Row = 4 To Cells(1, 6).Value - 1
If Begin Then
If Cells(Row, 3).Interior.ColorIndex = 44 Then
Start(i) = Row + 1
j = Cells(Row, 2).Value
Begin = False
End If
Else
If Cells(Row, 2).Value = j + 1 Or Cells(Row, 2).Interior.ColorIndex = 37 Then
Finish(i) = Row - 1
Begin = True
i = i + 1
Row = Row - 1
End If
End If
Next
The block I changed is as follows (code I added is last block where I attempt to hide rows). It precedes the previous. I am wondering how my change could have affect the above(?!)
If Cells(Row, 5).Value = "Requirement" Then
Range(Cells(Row, 4), Cells(Row, 4)).Interior.ColorIndex = 40
Rows(Row).Font.Bold = True
Rows(Row).Font.Italic = False
Rows(Row).Font.ColorIndex = 1 'Black
If Cells(Row - 3, 4).Value = "" Then 'this is requirement #1
Cells(Row, 4).Value = 1
Else
Cells(Row, 4).Value = Cells(Row - 3, 4).Value + 1
End If
p = Row
q = p + 2
Rows(p & ":" & q).Select
If Cells(p, 19).Value = "4" Then
Selection.EntireRow.Hidden = True
Else
Selection.EntireRow.Hidden = False
End If
Redim Start(0,50) makes the array dimensions 0 to 0, 0 to 50 i.e. a 2d array.
This means that when you call the array you need to provide parameters for both dimensions I.E: Start(0,i) or Finish(0,i). Calling Start(i) will result in the error you mentioned.
The easiest way to get rid of the error is to change your Redim lines to
ReDim Start(50)
ReDim Finish(50)
which is what I assume you meant to do in the first place.
Note: Based upon the format you used, you may have been meaning to do Start(0 to 50) and Finish(0 to 50) initially. The comma in the dimensioning indicates another dimension instead of a separation between lower and upper bounds.

Resources