I'm stuck in an assignment for school, this is what i have to do:
This is the current code I have:
You need to loop in the array you've loaded and :
Sub Ratio()
Dim OperatingRatio() As Double
Dim j As Long
With Sheets("Summary")
OperatingRatio = .Cells("I80:M80").Value
For j = LBound(OperatingRatio, 2) To UBound(OperatingRatio, 2)
If OperatingRatio(1, j) > 100 Then
MsgBox .Cells(14, 9 + j)
.Cells(80, 9 + j).Interior.Color = vbRed
Else
End If
Next j
End With
End Sub
It is better if you loop through all cells individually, like this:
Dim i As Integer
'9 means column I and 13 is column M
For i = 9 To 13
' Getting the percent values
Debug.Print Worksheets("Summary").Cells(80, i).Value
Next
This way you can continue by yourself.
Related
An analyst observed that the upward movement of stocks on Bovespa is repeated according to a mathematical sequence. He wants to find out what the next bullish sequences will be. Generate and save in Excel cells using macro the sequence 1, 3, 4, 7, 11, 18, 29, ... up to its twentieth term?
following my code in vba:
Sub GerarSequencia()
Dim num As Long
Dim previous As Long
Dim i As Integer
num = 0
previous = 0
For i = 1 To 20
If i = 1 Then
num = 1
Else
num = num + previous
End If
Cells(i, 1).Value = num
previous = num
Next i
End Sub
I tried to generate the sequence of the exercise but did it generate another one?
The sequence is a sommation of the earlier two values. So 1 + 3 = 4 and so on. Before you can start the sqequence you have to have two numbers. I think you can work with:
Sub GerarSequencia()
Dim intFirstNum, intSecondNum As Integer
Dim intCounter As Integer
intFirstNum = 1
intSecondNum = 3
Cells(1, 1) = intFirstNum
Cells(2, 1) = intSecondNum
For intCounter = 3 To 20
Cells(intCounter, 1).Value = Cells(intCounter - 2, 1).Value + Cells(intCounter - 1, 1).Value
Next intCounter
End Sub
So you see that I have made two additional variables which are filled with 1 and 3 (if you change them you can start wherever you want). From that point on, I start the loop from position 3. This is because the first two are already known.
From that point on you can run the sequence. You don't need an if statement in that case.
Generating a Sequence
Sub GerarSequencia()
Const nCOUNT As Long = 20
Dim nPrev As Long: nPrev = 1
Dim nCurr As Long: nCurr = 3
Cells(1, 1).Value = nPrev
Cells(2, 1).Value = nCurr
Dim nNext As Long
Dim i As Long
For i = 3 To nCOUNT
nNext = nPrev + nCurr ' sum up
Cells(i, 1).Value = nNext ' write
nPrev = nCurr ' swap
nCurr = nNext ' swap
Next i
' ' Return the worksheet results in the Immediate window (Ctrl + G).
' For i = 1 To 20
' Debug.Print Cells(i, 1).Value
' Next i
End Sub
I've written the following code to check if values in row A equal to "Forecast" then Range D5:D53 should have its contents cleared.
Row 1 is a vlookup so there's a formula that derives "Actual" or "Forecast"
Dim k As Integer
For k = 1 To 13
If Sheets("2017 Forecast").Cells(k, 1).Value = "Forecast" Then
Sheets("2017 Forecast").Range("D5:D53").Select.ClearContents
End If
Next k
There's no need to use Select before you use ClearContents.
Also, try adding UCase to make sure you don't have any CAPITAL letter in the middle of your text.
Code
Dim k As Integer
With ThisWorkbook.Sheets("2017 Forecast")
For k = 1 To 13
If UCase(.Cells(k, 1).Value2) = "FORECAST" Then
.Range("D5:D53").ClearContents
End If
Next k
End With
Maybe this works for you?
Option explicit
Sub Compare skies()
Dim k As long
Dim ValueRead as variant
With Sheets("2017 Forecast")
For k = 1 To 13
ValueRead = .Cells(k, 1).Value
' Slow, case insensitive string comparison '
If strcomp(ValueRead,"Forecast",vbtextcompare) = 0 Then
.Range("D5:D53").ClearContents ' You want to clear the exact same range 13 times? '
Elseif strcomp(ValueRead,"Actual",vbtextcompare) <> 0 then
Msgbox("VLOOKUP returned a value outside of Actual and Forecast")
End if
Next k
End with
End sub
I m trying to change color of cells based on value fron another sheets
Sub ColoredOutlier()
Dim i As Integer, j As Integer, x As Integer
For i = 1 To 50
For j = 2 To 23
If IsEmpty(Worksheets("outlier_index").Cells(i, j)) Then Exit For
x = Worksheets("outlier_index").Cells(i, j).Value
Worksheets("Sheet2").Cells(x+1, i).Interior.ColorIndex = 3
Next j
Next i
End Sub
When ı run these codes above I m getting "type mismatch" error becasue of
x = Worksheets("outlier_index").Cells(i, j).Value
Could anyone help me about solve my problem?
As suggested above the type mismatch error can occur when the value of the cell is not an integer.
You could easily modify your code to skip cells containing strings:
If IsEmpty(Worksheets("outlier_index").Cells(i, j)) Or Not _
IsNumeric(Worksheets("outlier_index").Cells(i, j)) Then Exit For
You might need to amend it a little further if you have non-integer numbers in your sheet too.
X should be a string. The value from a cell will be stored as String. And x should not be used here.
Worksheets("Sheet2").Cells(i, x).Interior.ColorIndex = 3
It should be
Worksheets("Sheet2").Cells(i, j).Interior.ColorIndex = 3
All together:
Sub ColoredOutlier()
Dim i As Integer, j As Integer, x As String
For i = 1 To 50
For j = 2 To 23
If IsEmpty(Worksheets("outlier_index").Cells(i, j)) Then Exit For
x = Worksheets("outlier_index").Cells(i, j).Value
Worksheets("Sheet2").Cells(i, j).Interior.ColorIndex = 3
Next j
Next i
End Sub
Sub Off_Hours_Set_TEST()
Dim x As String
Dim found As Boolean
Dim i As Integer, j As Integer
' Select first line of data.
Range("A1").Select
' Set search variable value.
x = "Off"
For i = 0 To 2
For j = 0 To 10
If ActiveCell.Value = x Then
found = True
ActiveCell.Offset(i, j + 2) = "0"
Else
ActiveCell.Offset(i, j + 2).Value = ActiveCell.Offset(i, j + 1).Value - ActiveCell.Offset(i, j).Value
End If
j = j + 2
Next j
Next i
End Sub
Trying to make a little code that tallies up hours worked for day. It works until it encounters the cell with the word 'Off' in it, then it RTE 13's on me. I'm not quiet sure why it does this, or where the mismatch is coming from, as all it is doing is checking to see if the cell = Off, if it does, it inputs a 0 in the offset hours worked column. Ideas?
Sub Add_sumf()
Dim i As Integer
i = 3
Dim cellDate As Integer
cellDate = 0
Dim cellDate1 As Date
cellDate1 = TimeValue("00:00:00")
Dim total As Integer
total = 0
Dim j As Integer
j = 2
Dim k As Integer
k = 2
Set aa = Workbooks("Book3").Worksheets(1)
Set bb = Workbooks("Final_result").Worksheets(1)
Do While bb.Cells(1, k).Value <> ""
For Each y In bb.Range("A:A")
On Error GoTo Label
If UCase(bb.Cells(j, "A").Value) <> "" Then
cellDate1 = WorksheetFunction.SumIfs(aa.Range("F:F"), aa.Range("B:B"), UCase(bb.Cells(1, k).Value), aa.Range("G:G"), UCase(bb.Cells(j, "A").Value))
bb.Cells(j, k).Value = TimeValue(cellDate1)
cellDate1 = TimeValue("00:00:00")
bb.Cells(j, k).NumberFormat = "[h]:mm:ss"
On Error GoTo Label
j = j + 1
Else
Exit For
End If
Next
j = 2
k = k + 1
Loop
Label:
'MsgBox Err.Description
Exit Sub
End Sub
I am using above code to add time duration based upon value of two other columns but I always get 00:00:00 as result.
if i use below code i get the answer but its too slow very slow
Sub add_it_time()
Dim i As Integer
i = 3
Dim cellDate As Integer
cellDate = 0
Dim cellDate1 As Date
cellDate1 = TimeValue("00:00:00")
Dim total As Integer
total = 0
Dim j As Integer
j = 2
Dim k As Integer
k = 2
Set aa = Workbooks("Book3").Worksheets(1)
Set bb = Workbooks("Final_result").Worksheets(1)
Do While bb.Cells(1, k).Value <> ""
'MsgBox bb.Cells(1, k).Value
For Each y In bb.Range("A:A")
On Error GoTo Label
' MsgBox UCase(bb.Cells(j, "A").Value)
If UCase(bb.Cells(j, "A").Value) <> "" Then
For Each x In aa.Range("F:F")
On Error Resume Next
If UCase(aa.Cells(i, "B").Value) = UCase(bb.Cells(j, "A").Value) Then
' MsgBox aa.Cells(i, "F").Text
' total = total + Int(get_Second(aa.Cells(i, "F").Text))
If UCase(aa.Cells(i, "G").Value) = UCase(bb.Cells(1, k).Value) Then
'MsgBox aa.Cells(i, "F").Text
cellDate1 = cellDate1 + TimeValue(aa.Cells(i, "F").Value)
End If
End If
i = i + 1
Next
i = 3
On Error GoTo Label
bb.Cells(j, k).NumberFormat = "h:mm:ss"
bb.Cells(j, k).Value = WorksheetFunction.Text(cellDate1, "[hh]:mm:ss")
total = 0
cellDate1 = 0
j = j + 1
Else
Exit For
End If
Next
j = 2
k = k + 1
Loop
Label:
'MsgBox Err.Description
Exit Sub
End Sub
The source column which contains date is of general formatt
I am new to VBA macros
UPDATED SOLUTION:
After discussion in chat with OP it was decided that pure formula solution is fine - below are formulas / actions to do on the separate sheet starting A1:
Row A will be resulting table header: in A1 I added Agent Name / Release Code, and starting B1 there's a list of all available Release Code values (easily got using Remove Duplicates).
I defined the following named ranges for the simplicity and effectiveness (since initial data is NOT static): AgentNames=OFFSET('Agent State'!$B$2,0,0,COUNTA('Agent State'!$B:$B)-1,1) - this will return the range of names on the initial sheet excluding the header; TimeInStateData=OFFSET(AgentNames,0,4) and ReleaseCodes=OFFSET(AgentNames,0,5) as shifted AgentNames range.
In column A we should obtain the list of names, which should be unique, so select in column A any number of cells which is NOT less that number of unique names - for the sample I used A2:A51, and type that formula: =IFERROR(INDEX(AgentNames,SMALL(IF(MATCH(AgentNames,AgentNames,0)=ROW(INDIRECT("1:"&ROWS(AgentNames))),MATCH(AgentNames,AgentNames,0),""),ROW(INDIRECT("1:"&ROWS(AgentNames))))),"") and press CTRL+SHIFT+ENTER instead of usual ENTER - this will define a Multicell ARRAY formula and will result in curly {} brackets around it (but do NOT type them manually!).
B2: =IF(OR($A2="",SUMPRODUCT(--($A2=AgentNames),--(B$1=ReleaseCodes),TIMEVALUE(TimeInStateData))=0),"",SUMPRODUCT(--($A2=AgentNames),--(B$1=ReleaseCodes),TIMEVALUE(TimeInStateData))) - normal formula, which will return empty value for either empty name or zero time.
Copy formula from B2 to the whole table.
Remarks:
Resulting range for the sum of time values should be formatted as Time.
If the list of names should be expanded in the future - repeat step 3 for the new range, but do NOT drag the formula down - this will result in You cannot change part of an array error.
Sample file: https://www.dropbox.com/s/quudyx1v2fup6sh/AgentsTimeSUM.xls
INITIAL ANSWER:
Perhaps that's too simple and obvious, but at a glance I don't understand why you have that line of code:
cellDate1 = TimeValue("00:00:00")
right after your SUMIFS: cellDate1 = WorksheetFunction.SumIfs(aa.Range("F:F"), ...
Try to remove the first one where you assign zeros to cellDate1.