Can someone please point out where I'm going wrong?
I want to delete certain rows if they fail to meet the criteria as provided in the code below.
I've tried Looping using the If statement and Instr function but not finding success.
Dim Firstrow As Integer
Dim Lastrow As Integer
Dim Lrow As Integer
Dim celltxt As String
Firstrow = 1
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For Lrow = Lastrow To Firstrow Step -1
If InStr(Lrow, Range("ED" & Lrow), "FTOP") > 0 Then Sheets(Sheet1).Rows(Lrow).Delete
If InStr(Lastrow, LCase(Range("DT" & Lrow)), "BB") > 0 Then Sheets(Sheet1).Rows(Lrow).Delete
If Sheets(Sheet1).Cells(Lrow, "DX").Value = "SET" Then Sheets(Sheet1).Rows(Lrow).Delete
If Sheets(Sheet1).Cells(Lrow, "EM").Value = "=*AAA" Then Sheets(Sheet1).Rows(Lrow).Delete
Next Lrow
No error messages
I've modified your macro to loop through each row from the Lastrow to row 2, and if the value or string part is found in any of the four columns in the row, the row will be deleted. Combined all the IF statements into one using OR. Removed Lrow and Lastrow from the INSTR function, and put AAA into an INSTR function. Lrow was confusing so I removed and used i variable for the loop. Also added a workbook/worksheet reference variable.
Sub DeleteRowsThatMeetCriteria()
'Declare your variables
Dim ws As Worksheet, Lastrow As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1") 'Set the worksheet
Lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Assign the last row varaible
For i = Lastrow To 2 Step -1 'Assign "i" as a long number to loop from the last row to row 2
'Because you are testing different columns for different value and performing the same delete function,
'you can combine each test using OR, so you only need one IF statement. I removed "Lrow and Lastrow" variables
'because they were causing confusion and not needed inside the INSTR function. Since "SET" was the only full word
'i did not change it. But I used INSTR for "AAA" since it was part of a string.
If InStr(ws.Range("DT" & i), "BB") <> 0 _
Or ws.Range("DX" & i).Value = "SET" _
Or InStr(ws.Range("ED" & i), "FTOP") <> 0 _
Or InStr(ws.Range("EM" & i), "AAA") <> 0 Then
ws.Rows(i).Delete
End If
Next i 'DaLoop
End Sub
Related
I have created a macro file with Forms and Word to Excel.
In this coding fewthings are not working as per my expectation.
Get unique Employee Name from Excel data base.
I want to add unique employee names from excel database and get is saved in a sheet. After that those values to be added to list box. Here i cannot define a range like "A1:A10".. I want to choose the data from A1 to end data.
If for each cell approach will not work, please help in do while approach
I need help in defining the range and code given below
ListEmployeeName.Clear
For Each cell In Worksheets("SunEmployeeDetails").Range("A1").End(xlDown)
ListEmployeeName.AddItem (cell.Value)
Next
ListEmployeeName.Value = Worksheets("SunEmployeeDetails").Range("A1")
End Sub
Find Last Row and then define your range Range("A1:A" & LastRow)
You can also find the last row and loop through the range using a For loop. Also to get unique Employee Name, you can use On Error Resume Next with a Collection as shown below. I have commented the code below so you should not have a problem understanding it. But if you do then simply ask.
Is this what you are trying? (Untested).
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim col As New Collection
Dim itm As Variant
Set ws = Worksheets("SunEmployeeDetails")
With ws
'~~> Find Last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through the range and add it to the unique
'~~> collection using "On Error Resume Next"
For i = 1 To lRow
On Error Resume Next
col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value)
On Error GoTo 0
Next i
End With
ListEmployeeName.Clear
'~~> add the itme from collection to the listbox
For Each itm In col
ListEmployeeName.AddItem itm
Next itm
End Sub
Here is my take on it, techniques taken from here:
Methode 1: Using a dictionary
Dim lr As Long, x As Long
Dim arr As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
With Sheet1 'Change accordingly
'Find the last used row
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("A1:A" & lr).Value
End With
'Loop through memory and fill dictionary
For x = LBound(arr) To UBound(arr)
dict(arr(x, 1)) = 1
Next x
'Add array to Listbox
Me.ListEmployeeName.List = dict.Keys
Methode 2: Using Evaluation
Dim lr As Long
Dim arr As Variant
With Sheet1 'Change accordingly
'Find the last used row
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
'Get array of unique values
arr = Filter(.Evaluate("TRANSPOSE(If(Row(A1:A" & lr & ")<>MATCH(A1:A" & lr & ",A1:A" & lr & ",0),""|"",A1:A" & lr & "))"), "|", False)
'Add array to Listbox
Me.ListEmployeeName.List = arr
End With
I have some code in VBA that is attempting to delete duplicate transaction IDs. However, i'd like to ammend the code to only delete duplicates that have a transaction ID - so, if there is no transaction ID, i'd like that row to be left alone. Here is my code below:
With MySheet
newLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
newLastCol = .Cells(5 & .Columns.Count).End(xlToLeft).Column
Set Newrange = .Range(.Cells(5, 1), .Cells(newLastRow, newLastCol))
Newrange.RemoveDuplicates Columns:=32, Header:= _
xlYes
End With
I was also wondering - in the remove.duplicates command - is there a way where I can have the column I want looked at to be named rather than have it be 32 in case I add or remove columns at a later date?
Here is an image of the data: I'd like the ExchTransID column that have those 3 blank spaces to be left alone.
Modify and try the below:
Option Explicit
Sub test()
Dim Lastrow As Long, Times As Long, i As Long
Dim rng As Range
Dim str As String
'Indicate the sheet your want to work with
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row with IDs
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Set the range with all IDS
Set rng = .Range("A1:A" & Lastrow)
'Loop column from buttom to top
For i = Lastrow To 1 Step -1
str = .Range("A" & i).Value
If str <> "" Then
Times = Application.WorksheetFunction.CountIf(rng, str)
If Times > 1 Then
.Rows(i).EntireRow.Delete
End If
End If
Next i
End With
End Sub
I have an Excel file with information in column A and column B. Since these columns could vary in the number of rows I would like to use the function offset so that I could print the formula in one time as an array rather than looping over the formula per cell (the dataset contains almost 1 million datapoints).
My code is actually working the way I want it to be I only can't figure out how to print the code in Range(D1:D5). The outcome is now printed in Range(D1:H1). Anybody familiar how to use this offset within a for statement?
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(0, i + 2).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
Using the Offset(Row, Column), you want to offset with the increment of row (i -1), and 3 columns to the right (from column "A" to column "D")
Try the modified code below:
Set example = Range("A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
One way of outputting the formula in one step, without looping, to the entire range, is to use the R1C1 notation:
Edit: Code modified to properly qualify worksheet references
Option Explicit
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set example = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
example.Offset(columnoffset:=3).FormulaR1C1 = "=sum(rc[-3],rc[-2])"
End Sub
You don't need to use VBA for this. Simply type =sum(A1:B1) in cell D1 and then fill it down.
If you're going to use VBA anyway, use this:
Sub checkOffset()
Dim example As Range
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set example = Range("A1:A1")
For i = 1 To LastRow
example.Offset(i - 1, 3).Formula = "=SUM(A" & i & ":B" & i & ")"
Next i
End Sub
The way offset works is with row offset, column offset. You want the column to always be fixed at 3 to the right.
My script takes data from multiple sheets and creates a new spreadsheet. The problem I am running into is how to append to the end of a column. I tried this:
LastRow = Sheets("Test").Cells(Rows.Count, "A").End(xlUp).Row
Where LastRow is defined as a long but I ran into an error when my loop continued going around. Here is what I have so far:
Sub autoFill()
Dim wb As Workbook, ws As Worksheet
Dim LastRow As Long
Dim Unit As String
Dim ddg As Variant, i As Variant
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Mapping")
ddg = ws.Range("F4:F21").Value
For Each i In ddg
Unit = "Unit #" & i
LastRow = Sheets("Test").Cells(Rows.Count, "A").End(xlUp).Row
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A1" & LastRow)
Sheets(Unit).Range("B2:B100").Copy Destination:=Sheets("Test").Range("B1" & LastRow)
Next i
End Sub
Just pick a range WAY above whatever the last row might be in whatever column will be populated (A in this case) when using xlUp. Add 1 to get to the next row:
LastRow = Sheets("Test").Range("A50000").End(xlUp).Row + 1
LAstRow now has a number that is equal to the first unused row in Column A of sheet Test.
Now concatenate that number to "A" to make a range like "A50". Right now you are doing:
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A1" & LastRow)
Which is concatenating the number to "A1" so you get "A150" which is nonsense... Instead:
Sheets(Unit).Range("A2:A100").Copy Destination:=Sheets("Test").Range("A" & LastRow)
Looking for a way to do an IF cell says (this) then VLOOKUP here, IF cell says (thiselse) then VLOOKUP different area.
Might be a super obvious way to do this, so far have this:
Pretty simple but not working
Sub categoryVLOOKUP()
'IF col D says STAR then enter VLOOKUP formula into column K
'IF col D says SUN then enter other VLOOKUP formula into column K
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
sht.Cells(lRow, 10).Formula = _
"=VLOOKUP(A3&G3,OF_MOON!A:D, 4,0)"
Else
End If
If sht.Cells(lRow, 4) = "STAR" Then
sht.Cells(lRow, 10).Formula = _
"=VLOOKUP(A3&G3,OFWORLD!A:D, 4,0)"
Else
End If
Next lRow
End Sub
If it is getting the formula for multiple cells that is the struggle, I would recommend R1C1 formatting:
Sub categoryVLOOKUP()
'IF col D says STAR then enter VLOOKUP formula into column K
'IF col D says SUN then enter other VLOOKUP formula into column K
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
Dim LastRow as long
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
sht.Cells(lRow, 10).FormulaR1C1 = _
"=VLOOKUP(R[1]C[-8]&R[1]C[-1],OF_MOON!RC:RC[3], 4,0)"
ElseIf
If sht.Cells(lRow, 4) = "STAR" Then
sht.Cells(lRow, 10).FormulaR1C1 = _
"=VLOOKUP(R[1]C[-8]&R[1]C[-1],OFWORLD!RC:RC[3], 4,0)"
End If
Next lRow
End Sub
I think this train of thought should get you started. Remember that R1C1 has to be done in reference to the active cell that the formula will go in. I may need to check the rules for referring to new sheets but again, this should get you on the right line :) hope it helps
EDIT : Also, I believe you do need to set LastRow
I have added to the code
Dim LastRow as long
and
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Looks like you are missing definition and value of LastRow.
Use option explicit at the beginning of your modules to enforce variable declaration. Or simply Tools -> Options -> check Require Variable Declaration. It will be done automatically.
Also I do not understand why you would even use VBA for this. Can't you just use formula
=IF(cell="SUN",1st vlookup, if(cell="STAR", 2nd vlookup,NA())
Also I suggest using INDEX + MATCH instead of VLOOKUP.
And 3rd "also": you are hardcoding the key you will be looking up for: A3&G3. Thus You will get max of 3 values from your actions: Whatever is associated with A3&G3 in OF_MOON sheet or in OFWORLD sheet or #N/A.
Another way to get the result as below
Sub categoryVLOOKUP()
Dim lRow As Long, lCol As Long
Dim lRow2 As Long
Dim sht As Worksheet
LastRow = Range("D" & Rows.Count).End(xlUp).Row
Set sht = ThisWorkbook.Worksheets("STARSUN")
For lRow = 2 To LastRow
If sht.Cells(lRow, 4) = "SUN" Then
Range("K" & lRow).Value = Application.WorksheetFunction.VLookup(Range("A" & lRow) & Range("G" & lRow), Worksheets("OF_MOON").Range("A:D"), 4, 0)
ElseIf sht.Cells(lRow, 4) = "STAR" Then
Range("K" & lRow).Value = Application.WorksheetFunction.VLookup(Range("A" & lRow) & Range("G" & lRow), Worksheets("OF_MOON").Range("A:D"), 4, 0)
End If
Next lRow
End Sub