I have four columns, loop over two of the columns using nested do while loops, and then two if statements to act as constraints. If the two if statements are passed, revalue (paste is an option too), two new cells to the values of the cells that were checked using the index on the first loop, and another two new cells to the values of the cells that were checked using the index on the nested loop.
code:
Dim i
Dim j
i = 1
j = 1
Do Until IsEmpty(Range("BE" & i))
Do Until IsEmpty(Range("BH" & j))
If Cells(i, "BE").Value = Cells(j, "BH").Value Then
If (Cells(j, "BG").Value - Cells(i, "BF")) < TimeValue("1:00:00") Then
'This is not correctly filtering, dates/time are in
' mm/dd/yy hh:mm format
Range("BJ" & i).Value = Range("BE" & i).Value
Range("Bk" & i).Value = Range("BF" & i).Value
Range("BL" & i).Value = Range("BG" & j).Value
Range("BM" & i).Value = Range("BH" & j).Value
End If
End If
j = j + 1
Loop
i = i + 1
j = 1
Loop
End Sub
What it does:
It does almost everything correctly. The issue is that it does NOT correctly check if the difference in time between cells BG(j) and BF(i) < 60 minutes. Whether using:
If (Cells(j, "BG").Value - Cells(i, "BF")) * 1440 < 60 Then
or
IF (Cells(j, "BG").Value - Cells(i, "BF")) < TimeValue("1:00:00") Then
values that are 5 hours in difference are being seen as true and passing through the if statement.
Try adding j = 1 just after i = i + 1
Related
I just started learning VBA but I can't really figure this out thing out.
I have a column with both positive and negative integers and what I want to do is to take the values that are positive and put them in a new column, and do the same for the negative values.
I tried making an if-statement but I only know how to shift their spots horizontally, so if I have a positive value in row 1,5,7,22 and 24 they'll appear in these rows in the next column instead of being in row 1,2,3,4 and 5.
I did that like this:
For i = 0 To NoofOb
If Range("D3").Offset(i + 1) > 0 Then
Range("G3").Offset(i) = Range("D3").Offset(i + 1)
ElseIf Range("D3").Offset(i + 1) < 0 Then
Range("J3").Offset(i) = Range("D3").Offset(i + 1)
End If
Next i
Could someone give me a hint or anything? I've been looking at this for hours and can't find an answer. Thanks in advance!
Try this:
j = 1
k = 1
For i = 3 To NoofOb
If Range("D" & i).Value > 0 Then
Range("G" & j).Value = Range("D" & i).Value
j = j + 1
ElseIf Range("D" & i).Value < 0 Then
Range("J" & k).Value = Range("D" & i).Value
k = k + 1
End If
Next i
note: I did not test this code and you may need to adjust the starting points of each column (i, j and k) to suit your needs
Another option, assuming columns G and J are empty before starting the macro
For i = 3 To NoofOb
With Range("D" & i) ‘ reference column D current i row
Select Case .Value2 ‘check referenced range value and sct accordingly
Case Is > 0 ‘ if it’s positive
Range("G" & Worksheetfunction.Count(Range("G:G")) + 1.Value2 = .Value2 ‘ fill column G next empty row
Case Is < 0 ‘ if it’s negative
Range("J" & Worksheetfunction.Count(Range("J:J")) + 1.Value2 = .Value2 ‘ fill column J next empty row
End Select
End With
Next
I am trying to fetch data from a webpage. My VBA code is as below
m = 0
For Each htmlele1 In doc.getElementsByClassName("resultsbranch")
m = m + 1
companyname = htmlele1.getElementsByTagName("h2")
Address = htmlele1.getElementsByTagName("span")
If Address.getAttribute("itemprop") = "myaddress" Then
Range("D" & i).Value = companyname.innerText + "," + Address.innerText
End If
Teliphone = htmlele1.getElementsByClassName("teldata")
If Teliphone.getAttribute("itemprop") = "tel" Then
Range("E" & i).Value = Teliphone.innerText
End If
'i = i + 1
'Debug.Print i
Next
On the first iteration, values are get inserted to columns D,E
on second iteration I want to insert data To F,H .
On 3 rd iteration I,J
On 4th iteration K,L
So on up to nth iteration
How can i do this ?
Instead of:
Range("D" & i).Value
Range("E" & i).Value
Use:
Cells(i, (m*2 + 3)).Value
Cells(i, (m*2 + 4)).Value
Or use another counter... As you like... Hope that helps.
I want to lookup the value in Columns C of Sheets("MV_Backtest") s.t cell_i match Columns A, cell_j match Columns B, here is the code:
Sub Matrix()
lastRow = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
lastColumn = ThisWorkbook.Sheets("Sheet2").Cells(1,
Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
For j = 3 To lastColumn
cell_i = ThisWorkbook.Sheets("Sheet2").Cells(i, 2)
cell_j = ThisWorkbook.Sheets("Sheet2").Cells(1, j)
Cells(i, j) = Application.WorksheetFunction.Lookup(1, 0 / (cell_i =
ThisWorkbook.Sheets("MV_Backtest").Columns("A:A")) * (cell_j =
ThisWorkbook.Sheets("MV_Backtest").Columns("B:B")),
ThisWorkbook.Sheets("MV_Backtest").Columns("C:C"))
Next j
Next i
End Sub
Note that each value in one column may not unique, but combining two values, it is unique.
It's ok in the Excel but there is something wrong here?
By the way, how could I set Cells(i, j) = 0 when neither of two conditions match.
Here is the Excel formula:
=LOOKUP(1,0/(I28=I20:I22)*(J28=J20:J22),K20:K22)
cell_i is I28, I20:I22 is Columns A, cell_j is J28, J20:J22 is Columns B, K20:K22 is Columns C.
(cell_i = ThisWorkbook.Sheets("MV_Backtest").Columns("A:A")) * (cell_j = ThisWorkbook.Sheets("MV_Backtest").Columns("B:B"))
While the above code looks correct for an Excel formula, it is not valid VBA. In Excel it generates and multiples two arrays, but you cannot generate an array like that in VBA (VBA does not allow array multiplication, array comparison, etc).
If you have a valid Excel formula, you can let Excel evaluate it then get the result. Two ways to do that:
1- Using Application.Evaluate:
Cells(i, j).value = Application.Evaluate("=Lookup(1,0/((" & cell_i & _
"= MV_Backtest!A:A) * (" & cell_j &_
"=MV_Backtest!B:B)), MV_Backtest!C:C)")
2- Using .Formula
Cells(i, j).Formula = "=Lookup(1,0/((" & _
cell_i & "=MV_Backtest!A:A) * (" & _
cell_j & "=MV_Backtest!B:B)), MV_Backtest!C:C)"
If you want after then to fix the value and remove the formula, you can:
Cells(i, j).Value = Cells(i, j).Value2
EDIT:
To set a cell to zero when no match exists, the usual way is the enclose the formula with IFERROR(myformula, 0). Hence, for example:
Cells(i, j).value = Application.Evaluate("=IFERROR(Lookup(1,0/((" & cell_i & _
"= MV_Backtest!A:A) * (" & cell_j &_
"=MV_Backtest!B:B)), MV_Backtest!C:C)), 0")
Or, you can check (in VBA) if the resulting value of the initial formula is an error code. i.e.
If IsError(Cells(i, j).Value) Then Cells(i, j).Value = 0
In my spreadsheet, I have a list of data in a column that has item numbers. Given a value (either "'1 Quad" or any value A-D) in an adjacent cell, there should be no rows with repeating item numbers or 8 rows with repeating item numbers respectively in the same column. If there are more or less than the required amount of item numbers (too many repeating numbers or missed numbers), then I would like the entire variable range of identical item numbers to highlight (which I am simply doing with Fill).
For i = 3 To (mainRow - 1)
k = i
j = i
If Range("G3") = "'1 Quad" Then
If Range("E" & i).Value > (Range("E" & (i + 1)).Value - 1) Then
Range("E" & i, "E" & (i + 1)).Interior.Color = RGB(255, 0, 0)
i = i + 1
End If
If Range("E" & i).Value < (Range("E" & (i + 1)).Value - 1) Then
Range("E" & i, "E" & (i + 1)).Interior.Color = RGB(0, 255, 0)
i = i + 1
End If
ElseIf Range("G3").Value = "A" Or "B" Or "C" Or "D" Then
Do
If Range("E" & j).Value = Range("E" & (j + 1)).Value Then
j = j + 1
End If
If Range("E" & j).Value <> Range("E" & (j + 1)).Value Then
If j < 8 Then
For k = i To j
Range("E" & i).Interior.Color = RGB(255, 0, 0)
Next k
End If
If j > 8 Then
For k = i To j
Range("E" & i).Interior.Color = RGB(0, 255, 0)
Next k
End If
Exit Do
End If
While j < (mainRow - 1)
i = k
End If
Next i
With This code, I am getting the error "End If without Block If" which does not appear to be the case at all. If I remove the last "End IF", I receive the "Next without For" error. Thanks ahead of time for your help.
**I edited the code to include the end ifs and still receiving the same error.
You're missing 3 End Ifs, and your Do-While syntax is off. Try this instead:
Do While j < (mainRow - 1)
If Range("E" & j).Value <> Range("E" & (j + 1)).Value Then
If j < 8 Then
For k = i To j
Range("E" & i).Interior.Color = RGB(255, 0, 0)
Next k
Exit Do
End If
If j > 8 Then
For k = i To j
Range("E" & i).Interior.Color = RGB(0, 255, 0)
Next k
Exit Do
End If
End If
Loop
And thanks in advance for any help you can provide. I'm fairly new to VBA and this is outside of my current capability.
Ok, so I have raw data that is broken up by date and time in 30 minute intervals (Columns A, B). I have built a loop to find a specific segment (lines of data using Start Time, and Stop Time). What I am having issues with is pulling a timeframe for multiple days. The code is pulling the entire segment from start to end time, regardless of the date. So I end up with a large chunk of data that needs to be trimmed down.
Here is the code I'm using currently.
Key: *A2 = Start Date, *B2 = Start Time, *C2 = End Date, *D2 = End Time.
'============================================
' Date/Time lookup in Adjusted Table
'============================================
Sheets("Allotments (ADJ)").Select
i = 1
Do Until Cells(i, 1) = ""
If Cells(i, 1) = Sheets("macros").Range("a2") Then
Do Until Cells(i, 1) <> Sheets("macros").Range("a2")
If Cells(i, 2) = Sheets("macros").Range("b2") Then
startrow = i
End If
i = i + 1
Loop
End If
i = i + 1
Loop
i = 1
Do Until Cells(i, 1) = ""
If Cells(i, 1) = Sheets("macros").Range("c2") Then
Do Until Cells(i, 1) <> Sheets("macros").Range("c2")
If Cells(i, 2) = Sheets("macros").Range("d2") Then
endrow = i
End If
i = i + 1
Loop
End If
i = i + 1
Loop
Sheets("Allotments (ADJ)").Range("a" & startrow & ":l" & endrow).Copy
Sheets("macros").Select
Range("c3").Select
ActiveSheet.Paste
CutCopyMode = False
Is there a way I can modify this to grab only a desgnated timeframe for each day, if I'm trying to pull from multiple date range?
After tinkering with it for a long time and making the variables clearer I was able to get a working version.
StartDate = DateValue(StartDate)
EndDate = DateValue(EndDate)
Sheets("Allotments (ADJ)").Select
If StartDate = EndDate Then
datestart = 2
Do Until Range("A" & datestart) = ""
If Sheets("Allotments (ADJ)").Range("A" & datestart).Value = StartDate Then
StartTimerow = datestart
Do Until Range("B" & StartTimerow).Value = StartTime
StartTimerow = StartTimerow + 1
Loop
Endtimerow = StartTimerow
Do Until Range("B" & Endtimerow).Value = EndTime
Endtimerow = Endtimerow + 1
Loop
Exit Do
End If
datestart = datestart + 1
Loop
Sheets("Allotments (ADJ)").Range("a" & StartTimerow & ":N" & Endtimerow).Copy
Sheets("Macros").Select
Range("C1").Select
Range("c" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
CutCopyMode = False
End Sub