I have a huge datasheet in excel, which i need sorted.
I need two columns to match based on a Dummy.
The dummy is either 'C'(call) or 'P'(put). The two other columns are 'expiration date' and 'strike price'.
I need to sort the datasheet so it is only containing C and P that have the same expiration date and strike price.
I've been trying go search the internet without any help. I can't really figure out how to program it in VBA.
Any help is really appreciated.
Thanks.
The solution I think: (I am addin a new column -column W- which is empty- to mark the row as "Matched" which is to be deleted after operation.)
First sub to mark the doublets (Matched Rows):
Private Sub FindDoublets()
Dim intRowC As Long
Dim intRowP As Long
Application.ScreenUpdating = False
Range("W1").EntireColumn.Insert
For intRowC = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(intRowC, 6).Value = "C" Then
For intRowP = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(intRowP, 6).Value = "P" Then
If Cells(intRowC, 4).Value = Cells(intRowP, 4).Value And Cells(intRowC, 7).Value = Cells(intRowP, 7).Value Then
Cells(intRowC, 23).Value = "Matched"
Cells(intRowP, 23).Value = "Matched"
End If
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
Second sub to delete not matched so not marked rows:
Private Sub DeleteNotMatchedRows()
Dim intRow As Long
Application.ScreenUpdating = False
For intRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If Cells(intRow, 23).Value <> "Matched" Then
Rows(intRow).Delete shift:=xlShiftUp
End If
Next
Range("W1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
In your example sheet enter this formula in column W: =IF(F2="C",TRUE,FALSE) and this one into column X: =COUNTIFS(D:D,D2,G:G,G2,W:W,NOT(W2))
Now you will have "1" in column X when actual row has a corresponding C / P row and "0" otherwise. Just need to filter for 0-s and delete the rows.
You can do the same with macro too but it's more complicated.
Related
I want to change the cell style based on the row number. I am still new on VBA.
Here is my code:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Rows.Count = 2 * i + 1 Then
Selection.Style = "Good"
ElseIf Rows.Count = 2 * i Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
The loop moves to the next cell but does not highlight if a criteria is met. May you please help me.
I suggest the following:
Option Explicit
Public Sub FormatEvenOddRowNumbers()
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 1 To FinalRow
If i Mod 2 = 0 Then 'even row number
Cells(i, 1).Style = "Good"
Else 'odd row number
Cells(i, 1).Style = "Bad"
End If
Next i
End Sub
To test if a row number is "even" you can use If i Mod 2 = 0 Then also you don't need to test for "odd" because if it is not "even" it must be "odd" so you can just use Else without any criteria.
Try to avoid using .Select it makes your code slow. See How to avoid using Select in Excel VBA. Instead access the cells directly like Cells(row, column).
First, I think you missused Rows.Count.
Rows.Count returns the total number of rows of your sheet. So now your criteria is only highlighting the two rows that are in the middle of the sheet.
If I assume correctly that you want to put "Good" the Rows that are even and "bad" the ones that are odds. then you should change your code to something like this:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If i/2 = int(i/2) Then
Selection.Style = "Good"
ElseIf (i+1)/2 = int((i+1)/2) Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
I have this VBA code to delete rows in excel
Sub deleterows()
i = 1
Do Until i = 150000
If ActiveCell.Value = False Then
ActiveCell.EntireRow.Delete
End If
ActiveCell.Offset(1, 0).Activate
i = i + 1
Loop
End Sub
However this code is not deleting all the rows that contain the "False" value, I've been trying to change it to activecell.value="" and activecell.value=vbnullstring but still it does not deletes all blank rows
You should move from the last row to the top, if you're deleting rows.
Also, it's best to avoid using ActiveCell.
Sub deleterows2()
i = 1
For i = 150000 To 1 Step -1
If Cells(i, 1).Value = False Or Cells(i, 1).Value = "False" Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Tweak as needed. I'm assuming your column A has the cells you're checking for. If it's another column, just use that column's index number in the Cells(i,1). So if you need to check column D, use Cells(i,4)
You can fix it with a small change as follows:
If ActiveCell.Value = False Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Basically, you should only activate the next sell when the value is != False, otherwise it will skip rows.
Here's a handful of nice things baked in to what it looks like what you want to accomplish.
I'm assuming that 150000 is basically just a big number so that you are confident that all used rows are being considered.
Sub DeleteRows()
i = 0
Do While ActiveCell.Offset(i, 0).Row <= ActiveCell.End(xlDown).Row
'This only considers used rows - much better than considering 15,000 rows even if you're only using 100
If ActiveCell.Offset(i, 0).Value <> 1 Then
'If you directly have a boolean value (i.e. 'True', 'False', or '0','1', you do not need to compare to another value. If your cells contain text, compare with the string in quotes (i.e. ...= "False")
ActiveCell.Offset(i, 0).Delete
Else: i = i + 1
End If
'Don't have to activate the next cell because we're referencing off of a fixed cell
Loop
End Sub
I wrote a small VBA macro to compare two worksheets and put unique values onto a new 3rd worksheet.
The code works, but every time I use if excel goes "not responding" and after 30-45sec comes back and everything worked as it should.
Can I make this faster and get rid of the "not responding" issue? is it just my computer not being fast enough?
I start with about 2500-2700 rows in each sheet I'm comparing.
Sub FilterNew()
Dim LastRow, x As Long
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "New" 'Adds a new Sheet to store unique values
Sheets(1).Rows("1:1").Copy Sheets("New").Rows("1:1") 'Copies the header row to the new sheet
Sheets(1).Select
LastRow = Range("B1").End(xlDown).Row
Application.ScreenUpdating = False
For Each Cell In Range("B2:B" & LastRow)
x = 2 'This is for looking through rows of sheet2
Dim unique As Boolean: unique = True
Do
If Cell.Value = Sheets(2).Cells(x, "B").Value Then 'Test if cell matches any cell on Sheet2
unique = False 'If the cells match, then its not unique
Exit Do 'And no need to continue testing
End If
x = x + 1
Loop Until IsEmpty(Sheets(2).Cells(x, "B"))
If unique = True Then
Cell.EntireRow.Copy Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub
This belongs in Code Review, but here is a link
http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html
With your code your main issues are:
Selecting/Activating Sheets
Copy & pasting.
Fix those things and youll be set straight my friend :)
instead of a do...loop to find out duplicate, I would use range.find method:
set r = SHeets(2).range("b:b").find cell.value
if r is nothing then unique = true else unique = false
(quickly written and untested)
What about this (it's should help):
Sub FilterNew()
Dim Cel, Rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "New" 'Adds a new Sheet to store unique values
Sheets(1).Rows("1:1").Copy Sheets("New").Rows("1:1") 'Copies the header row to the new sheet
Set Rng = Sheet(1).Range("B2:B" & Sheet(1).Range("B1").End(xlDown).Row)
For Each Cel In Rng
If Cel.Value <> Sheet(2).Cells(Cel.Row, 2).Value Then Cel.EntireRow.Copy Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) ' The only issue I have with this is that this doesn't actually tell you if the value is unique, it just tells you ins not on the same rows of the first and second sheet - Is this alright with you?
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I need help.
I have words and numbers in column A3:A500
and I need to change their names.
if a cell contains the word "previ" than put in a new column the letter "p" if the cells is a number. if its a word then dont put "p"
...like turning a flag on and off.
This is what i have:
Sub()
For i=3 to 500
x= range("a:"&i).value
If x contains "previ" Then
prevflag=1
ElseIf x is not integer Then
prevflag=0
End If
If prevflag=1 Then
range("H:"& i )= "p"
End If
Next i
End Sub
Can you guys help me make this work?
and thank you!!
this is what it needs to look like
https://postimg.org/image/e62z4xwlj/
Looking at your example, it looks like you want to put the "p" in rows in a section with a header that contains "previ" but not in a section with a header that doesn't. You also seem to want "p" in rows which have a blank in column A, not just integers. Does the below work for you?
Public Sub addPs()
Dim previFlag As Boolean
Dim c As Range: For Each c In Range("a1:a51")
If InStr(c.Value, "previ") > 0 Then
previFlag = True
ElseIf Not IsNumeric(c.Value) Then
previFlag = False
End If
If IsNumeric(c.Value) Then
If Int(c.Value) = c.Value And previFlag Then c.Offset(0, 3) = "p"
End If
Next c
End Sub
you may be after something like this
Option Explicit
Sub main()
Dim iRow As Long, lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).row
iRow = 3
Do
If InStr(Cells(iRow, 1).Value, "previ") > 0 Then '<--| if current cell contains "previ
iRow = iRow + 1 '<--| then then start scanning for numeric values
Do
If IsNumeric(Cells(iRow, 1).Value) Then Cells(iRow, 3).Value = "p" '<--| if current cell is numeric then write "p" two cells left of it
iRow = iRow + 1
Loop While InStr(Cells(iRow, 1).Value, "Type") = 0 And iRow <= lastRow
Else
iRow = iRow + 1 '<--| else skip to next row
End If
Loop While iRow <= lastRow
End Sub
just change the column offset to your needs (you wrote column "H" but your example has "p"s in column "C")
I did not understand the cases, but still, this is how you check for numeric values:
?isnumeric(6)
True
?isnumeric("test")
False
In your code:
else if not isnumeric(x) then
Does this need to be done with VBA? You could put this formula in H3 and paste it down to H500:
=IF(ISERROR(FIND("previ",A3)),"","p")
However, this doesnt deal with your number criteria, but I don't know what you mean by that. If a cell contains "previ", that cell is not numeric. It may have some numeric digits in it somewhere, but "previ04578" is not a number. Could you share some sample data? Failing that you can check for any numeric digit with stacked substitutions and a length comparison, for example:
=IF(ISERROR(FIND("previ",A3)),"",IF(LEN(A1)=LEN(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"0",""),"9",""),"8",""),"7",""),"6",""),"5",""),"4",""),"3",""),"2",""),"1","")),"p",""))
Another alternative...
Sub FlagRows()
Dim i As Long, val As Variant, bFlag As Boolean: bFlag = False
With Sheets("Sheet1")
For i = 1 To 500
val = .Cells(i, 1).Value
bFlag = IIf(Not IsNumeric(val), IIf(InStr(CStr(val), "previ"), True, False), bFlag)
If IsNumeric(val) And bFlag = True Then .Cells(i, 4).Value = "p"
Next i
End With
End Sub
I am trying to create a conditional loop macro in Excel. Column B contains a last name, Column C contains a first name, and Column D contains a first and last name. I am trying to get the macro to detect when Column D = Column C + Column B.
If D = C + B, then clear contents of D.
So, the following works for a single row:
Sub ClearContentsD ()
If Range("D1").Value = Range("C1").Value + Space(1) + Range("B1") Then Range("D1").ClearContents
End Sub
It does not work without the added Space(1), and I cannot get it to loop through the whole worksheet:
Sub ClearContentsLoop()
Application.ScreenUpdating = False
Dim i As Long
For i = 1 To Rows.Count
Next i
Do While Cells(i, 4).Value = Cells(i, 3).Value + Space(1) + Cells(i, 2).Value
Cells(i, 4).ClearContents
Loop
Application.ScreenUpdating = True
End Sub
VBA doesn't like my Do While. Any help would be greatly appreciated.
CJ
Some issues:
You must concatenate strings with &. The plus (+) is for addition;
Your For loop is not doing anything: its body is empty;
Your Do While Loop will at most run once, because i is not incremented;
It is a mystery why you would want two loops (For and Do While);
A sheet has many rows of which you only use a fraction, so don't loop through all of them (For) and use UsedRange.
Possible correction:
Sub ClearContentsLoop()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, 4).Value = Cells(i, 3).Value & " " & Cells(i, 2).Value Then
Cells(i, 4).ClearContents
End If
Next i
Application.ScreenUpdating = True
End Sub
There is a way to ignore the space in the values you are evaluating. Try this:
Application.ScreenUpdating = False
Dim i As Long
For i = 1 To Rows.Count
If InStr(1, Cells(i, 4).Value, Cells(i, 2).Value, vbTextCompare) > 0 And InStr(1, Cells(i, 4).Value, Cells(i, 3).Value, vbTextCompare) > 0 Then Cells(i, 4).ClearContents
Next i
Application.ScreenUpdating = True
Explanation:
By using the InStr function, you are testing for the presence of one text string inside of another, and if at least one match is found, then the function returns a non-zero value (the position where the match was found). In the above example, you are testing for the presence of the first name and last name at the same time, and if both are found, then the code clears out the contents of the cell.
And, as was pointed out in the comments section, you need to do this inside the loop so that all cells down the length of the worksheet are evaluated and updated as specified.
Be sure to test this on a COPY of your original data so that you don't lose the original values in case you want to roll back your changes! ;)