I want to creat a macro that matches against a whitelist, then delete everything that's not on the whitelist. I have the following code:
Sub WHITELIST()
Dim LR As Long, i As Long
With Sheets("Sheet1")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 1 Step -1
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) Then .Rows(i).Delete
Next i
End With
End Sub
But my code deletes the entire row. I only want to delete the range A:B and shift the cells up (the row size is variable so i always want to check till the last row - up to 40.000 rows). Its important that "important Data" doesn't gets deleted too. Here is an example how the macro SHOULD work:
Hope someone can help me
Greetings
Try changing this line
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) _
Then .Rows(i).Delete
to this
If IsError(Application.Match(.Range("A" & i).Value, Sheets("Whitelist").Columns("A"), 0)) _
Then .Range("A" & i & ":B" & i).Delete Shift:=xlUp
This will only delete the cells in columns A and B.
Using the Shift:=xlUp will allow you delete those specific cells in the range you define and move the entire block of cells below that range up.
Related
Okay I know there are multiple questions similar to this, but at least from what I've found, my problem is different so please bear with me.
I am building a user form that allows users to input data into a tracking sheet, but there are certain scenarios where only part of the data will get submitted at a time,leaving "holes" in the tracking sheet. My goal is to fill these "holes" with a period so that way relevant data will stay together in the same row instead of getting bumped up into those holes.
Sheets("Tracker").Activate
Worksheets("Tracker").Columns("A:J").Replace What:="", Replacement:=".", _
SearchOrder:=xlByColumns, MatchCase:=False
I realize I am essentially telling excel to fill columns A through J with a period, so my question is, is there an easier way to do this, or a way to specify that I only need the most recent row to contain the periods?
Update:
This is the code I am using to find the next available row in the tracker for new data to go. Thus when portions of the previous row are missing, the macro fills those unused cells with the next rows data.
Set ws = Sheets("Tracker") Sheets("Tracker").Select
ws.Range("E" & LastRow).Value = job_txtb.Text
'Finds the last blank row
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
'Adds the Job name Code into Col E & Last Blank Row
The following will give you the first unused row. I don't understand why periods would be necessary.
With ActiveSheet
On Error Resume Next
lastRow = .Cells.Find("*", .Cells(.Cells.Count), xlFormulas, _
xlWhole, xlByRows, xlNext).Row
If Err <> 0 Then lastRow = 0
End With
firstUnusedRow = lastRow + 1
Range("A" & firstUnusedRow).Value = Textbox1.Value
Range("B" & firstUnusedRow).Value = Textbox2.Value
Range("C" & firstUnusedRow).Value = Textbox3.Value
'etc.
'etc.,,
Can I get some help with this macro. I want to go through all values in column P of a table in 'Sheet1'. Here is a picture of the table:
First Table
If value is <1 I want to copy paste the values in columns with the headings in the picture to a table in an 'explanation' sheet in the following format:
Second Table
Any help with this would be appreciated
On the sheet you want the data to go into (table 2) and under your header (in table 2) set the cell equal to the cell you want from table 1. Do this by entering pressing "=" and then clicking to the sheet with table 1 and click on the cell on the first row. Repeat this for the Name, Identifier, Sector, Rate... Once you have the first row done, highlight the cells on the second row and click and hold the bottom right of the black out line and drag down to the same number of rows from table 1.
If you want the values pasted there, then highlight the range and copy and right click paste > paste special (click on paste special) and select values.
Then you can sort the data based on the explanation sheet by the column that's value you need to be less than 1 and delete the rows that are greater than 1.
I have no idea what columns you want copied as they are not named in the first table image you have, so I just did up a macro that you can adjust the ranges yourself as you need copied and to what sheet you need.
The below code loops through your data, checks if the data in Column P for each row is less than 1 and puts the data into a variable where you can copy and paste to where ever you need that data,
The code,
Sub d()
Dim i As Long
Dim lastrow As Long
Dim rng As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Range("P" & i).Value < 1 Then
If Not rng Is Nothing Then
Set rng = Union(rng, Range("B" & i), Range("C" & i), Range("D" & i), Range("Q" & i), Range("H" & i), Range("I" & i), Range("P" & i))
Else
Set rng = Union(Range("B" & i), Range("C" & i), Range("D" & i), Range("Q" & i), Range("H" & i), Range("I" & i), Range("P" & i))
End If
End If
Next
rng.Copy Sheets("explanation").Range("A2")
End Sub
See if this does not help any?
I'm currently trying to use VBA to copy some cells from one location to another and because I'm new to VBA I was wondering if anyone could help me make my code a bit more efficient I know there must be a way to copy to a cell without having to select the cell and then copy to it
For i = 1 To dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Row
dataSheet.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = dataSheet.Range("C" & i)
pasteSheet.Activate
If rCell = condition1 Then
With ActiveSheet
.Range("CU" & rowLoop2).Select
ActiveSheet.paste
End With
You have 2 options. Either use the .PasteSpecial method, or you can just reference the original range and set the new range to it's value.
.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
With the setting values option, you have to define the whole range which the values should fill.
Range("A3:E3").Value = Range("A1:E1").Value
If you just used Range("A3").Value = Range("A1:E1").Value only cell A3 would be populated, and it would take th value from cell A1. Hope this helps.
Edit: it's worth noting that you do not have to change sheets to paste either. Your code could be amended to the below:
With dataSheet
For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A" & i & ":" & "CT" & i).Copy
Set rCell = .Range("C" & i)
If rCell = condition1 Then
pasteSheet.Range("CU" & rowLoop2).PasteSpecial Paste:=xlPasteAll
End If
Next i
End With
I tried adapting this post: Error in finding last used cell in VBA to my needs but couldn't quite get it to work.
I'm pasting data into a new worksheet and then want to select the first empty row after data. Currently what's happening is the data is pasted and then the very first row in the sheet is selected. See code below. Any thoughts?
'runs when user enters data
If Target.Cells.Count = 1 And _
Not Application.Intersect(Target, [I3:I10000]) Is Nothing Then
Application.EnableEvents = False
'User inputs type of event
Archive = InputBox("Was this event a Win, Loss, or Close? (Please input Win/Loss/Close)")
With Target
If Archive = "Win" Then
'all data to transfer is selected and cut
.EntireRow.Select
Selection.Cut
'the receiving sheet is selected and data is pasted to the selected cell
Sheets("Win").Select
ActiveSheet.Paste
'the selection on the sheet the data was cut from is deleted
Sheets("Begin").Select
Selection.Delete
'this is the issue I'm having - I want to select the row below the row I just copied into.
Sheets("Win").Select
lastRow = Range("C" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range("C" & lastRow & ":C" & lastRow).EntireRow.Select
Sheets("Begin").Select
Try replacing this:
'this is the issue I'm having - I want to select the row below the row I just copied into.
Sheets("Win").Select
lastRow = Range("C" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range("C" & lastRow & ":C" & lastRow).EntireRow.Select
with this:
With Sheets("Win")
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
.Cells(lastRow + 1, 1).EntireRow.Select
End With
Just to add to the existing answer. You can avoid doing so much selection by using a construction more like this:
On Error GoTo problem
Dim Archive As String
If (Target.Cells.Count = 1) And _
Not (Excel.Application.Intersect(Target, [I3:I10000]) Is Nothing) Then
Excel.Application.EnableEvents = False
'User inputs type of event
Archive = InputBox("Was this event a Win, Loss, or Close? (Please input Win/Loss/Close)")
With Target
'>>>> good idea to defend against users entering "win" instead of "Win"
If (LCase(Archive) = "win") Then
'>>>> find the last row in Win sheet at the beginning
With Sheets("Win")
lr = .Range("C" & .Rows.Count).End(Excel.xlUp).Row
End With
'>>>> as you are cutting there should be no need to do any subsequent deletion or clearcontents
.EntireRow.Cut Sheets("Win").Rows(lr + 1)
End If
End With
End If
problem:
Excel.Application.EnableEvents = True
I am not a programmer but have managed to cobble together great amounts of code that work on 4 pretty large projects (Yay for me!) I have tried numerous ways to find the Last Row. Some work for me some don't. I can find a few that give me the "actual" last row regardless of blanks in Column A (this is what I need). Yet I CANNOT for my life figure how to integrate that code with the way I am passing values from my array from one workbook to another. All of the code works "As Is" but I need to find a better way of searching the whole row (currently columns A:O) for the Last Row and then copying the data over. Column A maybe empty at times and to avoid the code from being overwritten, that "Last Row" needs to check the whole row. I am currently forcing a hidden cell (A7) with a "." as a forced placeholder. Any advice would be awesome.
Option Explicit
Public Sub SaveToLog15()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long
Dim LastRow As Long
Dim NextCell As Range
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
Application.ScreenUpdating = False
With Sheet2
' rng are the cells you want to read into the array.
' Cell A7 (".") is a needed "Forced Place Holder" for last row _
determination
' A7 will go away once "better" LastRow can be added to this code
Set rng = Worksheets("Main").Range("A7,D22,D19,D20,J22:J24,E23,D21,J25:J27,D62,D63,G51")
' counts number of cells in MyAr
n = rng.Cells.Count
' Redimensions array for above range
ReDim MyAr(1 To n)
' Sets start cell at 1 or "A"
n = 1
' Loops through cells to add data to the array
For Each aCell In rng.Cells
MyAr(n) = aCell.Value
n = n + 1
Next aCell
End With
On Error Resume Next
' Opens "Test Log.xls"
Workbooks.Open FileName:= _
"S:\Test Folder\Test Log.xls"
' SUBROUTINE 1 "Disable Sheet Protection and Show All" REMOVED
' Finds last row on Tab "Tracking" based on Column "A"
' Last row determination DOES NOT go to next row if first _
Column is blank
' Use A7 "." to always force Data to Col A
'**********************************************************************
'THIS WORKS FINE BUT DOES NOT RECOGNIZE THE POSSIBLE BLANK IN COL A.
With Worksheets("Incoming Data")
Set NextCell = Worksheets("Incoming Data").Cells _
(Worksheets("Incoming Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
' I need this code replaced by the following code or integrated into
' this code snippet. I am lost on how to make that happen.
'***********************************************************************
'***********************************************************************
'THIS CODE FINDS THE "ACTUAL" LAST ROW AND THIS IS WHAT I'D LIKE TO USE
' I need to figure how to integrate this code block with the above
' Or maybe redo the whole thing.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
' I am not using this code in the program. It's just there to show
' what I need to use because it works. I need to make this code work
'WITH the above block.
'***********************************************************************
' Sets the size of the new array and copies MyAr to it
NextCell.Resize(1, UBound(MyAr)).Value = (MyAr)
' SUBROUTINE 2 "Add borders to cells in range" REMOVED
' SUBROUTINE 3 "Re-enable Sheet Protection" REMOVED
ActiveWorkbook.Save
'ActiveWindow.Close
Application.ScreenUpdating = True
MsgBox "Your Data has been saved to the Log File: " & vbCrLf & vbCrLf _
& "'Test Log.xls'", vbInformation, "Log Save Confirmation"
End Sub
This is a common problem with "jagged" data like:
Clearly here column B has that last row. Here is one way to get that overall Last row by looping over the four candidate columns:
Sub RealLast()
Dim m As Long
m = 0
For i = 1 To 4
candidate = Cells(Rows.Count, i).End(xlUp).Row
If candidate > m Then m = candidate
Next i
MsgBox m
End Sub
:
Find works best for most situations, below is the function i use that takes sheet ref as input and returns row number as type Long
Dim lLastRow As Long
lLastRow = LastUsedRow(shName)
Private Function LastUsedRow(sh As Worksheet) As Long
LastUsedRow = sh.Cells.Find(What:="*", After:=sh.Cells.Cells(1), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function
The simplest thing might be to use the specialcells method, as in range.specialcells(xllastcell). This returns the cell whose row number is the last row used anywhere in the spreadsheet, and whose column is the last column used anywhere in the worksheet. (I don't think it matters what "range" you specify; the result is always the last cell on the worksheet.)
So if you have data in cells B30 and X5 and nowhere else, cells.specialcells(xllastcell) will point to cell X30 (and range("A1").specialcells(xlastcell) will also point to cell X30).
Instead of:
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
use this:
LastRow = cells.specialcells(xllastcell).row
MsgBox ("The Last Row Is: " & LastRow)
After 35 attempts this is the code that I was able to hack into my original:
' Used to determine LastRow, LastColumn, LastCell, NextCell
Dim LastRow As Long
Dim LastColumn As Integer
Dim LastCell As Range, NextCell As Range
With Worksheets("Tracking")
' Find LastRow. Works Best. 1st and last cells can be empty
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox "Last Cell" & vbCrLf & vbCrLf & Cells(LastRow, LastColumn).Address
'MsgBox "The Last Row is: " & vbCrLf & vbCrLf & LastRow
'MsgBox "The Last Column is: " & vbCrLf & vbCrLf & LastColumn
End If
' Number of columns based on actual size of log range NOT MyAr(n)
Set NextCell = Worksheets("Tracking").Cells(LastRow + 1, (LastColumn - 10))
End With
This finds the "Real" Last Row and column and ignores any empty cells in Column A or J which seem to affect some of the LastRow snippets. I needed to make it ROWS instead of ROW and HAD the add the Offset portion as well. (-10) puts me back to Column "A" for my sheet and now I have removed Column "A" {the forced Place Holder "."} and have "Real" data there now. YAY for the "Hacking Code Cobbler".
Glad they pay me at work to learn this stuff. :) Solved this a while back. Just now got to update this post.