I'm hoping someone can help me with this. I have a spreadsheet with 2 sheets one called Details and another called Reconciled. I have 1000+ rows in Details and I want to cut all rows that have 0 or a - in column E (I want to cut the entire row) and paste it into sheet Details. If possible I would like to copy and paste the headers from Reconciled into Details as well.
I've tried using this code (modified slightly) used in another post
Sub Test()
For Each Cell In Sheets("Details").Range("E:E")
If Cell.Value = "0" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Reconcile").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("Details").Select
End If
Next
End Sub
But there are 2 problems. Because some values - (numbers are truly) those get moved, but the ones that are 0.00 do not get moved because they are rounded (I think that's why they are not being moved). Also, the screen updates oddly, and I'm sorry I can't explain it more than.
Any help would be appreciated
Sub Test()
Application.ScreenUpdating = False
On Error Goto Finish
For Each Cell In Sheets("Details").Range("E:E")
If Cell.Value = 0 Or Cell.Value = "-" Then cell.EntireRow.copy Sheets("Reconcile").Rows(cell.Row)
Next
Finish:
Application.ScreenUpdating = True
End Sub
Notice: dont put quotes around the 0, this will make numeric comparison
Using Autofilter:
Public Sub Test()
Application.ScreenUpdating = False
With Worksheets("Details").UsedRange
.Parent.AutoFilterMode = False
.AutoFilter
.AutoFilter Field:=5, Criteria1:="0"
.Copy
With Worksheets("Reconciled").Cells(1, 1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteAll
.Parent.Activate: .Select
End With
.Rows(1).Hidden = True
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Rows(1).Hidden = False
.AutoFilter
.Parent.Activate
.Cells(1, 1).Activate
End With
Application.ScreenUpdating = True
End Sub
Related
I managed to get the filter row using the following.
Sub FilterRows()
ActiveSheet.Range("A1").AutoFilter field:=7, Criteria1:=" = "
ActiveSheet.Range("A1").AutoFilter field:=11, Criteria1:="<>"
End Sub
But when I tried to use this to remove the filtered row, it ends up delete my entire data except my header.
Public Sub test()
ActiveSheet.Range("A1").AutoFilter field:=1, Criteria1:="A"
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
End Sub
How can I just removed the filtered row while keeping my data and header?
Change the range in the brackets to fit your range and try:
ActiveSheet.Range("$A$1:$A$" & Lastrow).Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
Hello I have the following MACRO...
Sub RunThis()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
ThisWorkbook.Sheets("Conditions").Range("A27:H54").Copy
With ThisWorkbook.Sheets("Project")
.Range("A1").PasteSpecial xlPasteValues
.Range("A1").PasteSpecial xlPasteFormats
End With
ThisWorkbook.Sheets("Conditions").Range("A56:H88").Copy
With ThisWorkbook.Sheets("Project")
.Range("A29").PasteSpecial xlPasteValues
.Range("A29").PasteSpecial xlPasteFormats
End With
Call DeleteCellsWithNo
End With
**With ThisWorkbook.Sheets("Project")
.Cells("A, 1").Select
End With**
End Sub
What I'm trying to do is Make is select the Cell A1 - also, I'm trying to format the width of cell A1 to autowidth....Any idea?
EDIT: the two stars next to WITH is what i'm trying to do but it gives me an error
EDIT2:
With ThisWorkbook.Sheets("Project")
.Cells(1, "A").Select
.Cells(1, "A").Width = 50
End With
I have this but gives me errors on the WIDTH part. I guess I want to set the width because the values are of different length so 50 will work for all
I might misunderstand your point, but if you want to autowidth your cell (your column) this works:
ThisWorkbook.Sheets("Project").Columns("A:A").AutoFit
I'm trying to create a userform in VBA that will search a list in another sheet and display all matching results, is it also possible to have that data displayed by default to then be narrowed down by the search box value?
There are three columns in the list it will search, but if it finds a match, ideally it would display the data from the first and third, the middle column is irrelevant, but needs to stay for other code.
Then you might need to select one of the results to display it in a specific folder in the workbook (column one result in one cell, column two in the cell next to it).
I'm completely new to userforms so a task like this is quite daunting, I'm not even certain how to activate the form from the sheet.
Any feedback is appreciated, I'll comment any useful code I find online.
Accomplished most of what I was after with the following:
Private Sub SearchButton_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
On Error GoTo ErrorHandler
Workbooks("Form1.xlsm").Worksheets("Employees").Visible = True
ActiveWorkbook.Sheets("Employees").Activate
Employee = EmployeeName.Value
lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$2:$C$" & lastrow).AutoFilter Field:=1, Criteria1:= _
"=*" & Employee & "*", Operator:=xlAnd
Workbooks("Form1.xlsm").Worksheets("Temp").Visible = xlSheetVisible
Workbooks("Form1.xlsm").Worksheets("Temp").Range("A1:AFD1000000").ClearContents
'validation to stop the form breaking if a nane is searched that doesnt exist
Range("A1000000").Select
Selection.End(xlUp).Select
If ActiveCell.Value = "KeyID" Then GoTo validationend
'Take the data that has been filtered by employee name and store it in a temp worksheet
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks("Form1.xlsm").Worksheets("Temp").Activate
Range("A1").Select
ActiveSheet.Paste
'Delete any data that is irrelevant at this stage
Range("D:D").Delete Shift:=xlToLeft
Range("E:E").Delete Shift:=xlToLeft
Range("G:AZ").Delete Shift:=xlToLeft
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("Temp")
For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row Step 1
If ws.Cells(i, 1).Value <> vbNullString Then Me.ListBox.AddItem ws.Cells(i, 1).Value
Next i
validationend:
Workbooks("Form1.xlsm").Worksheets("Form").Activate
'Workbooks("Form1.xlsm").Worksheets("Temp").Visible = xlSheetVeryHidden
'Workbooks("Form1.xlsm").Worksheets("Employees").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrorHandler:
MsgBox ("Error: Name not found. Please check your spelling and try again.")
Workbooks("Form1.xlsm").Worksheets("Form").Activate
'Workbooks("Form1.xlsm").Worksheets("Temp").Visible = xlSheetVeryHidden
'Workbooks("Form1.xlsm").Worksheets("Employees").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Doesn't work perfectly, so if you want more answers, I'll be asking relevant questions soon.
I would like to loop through column A in Worksheet1 and find the first cell which has a specified text "Oil Production". This cell is the first cell in the array I wish to copy to Worksheet2. This cell and the size of the array will change from time to time, hence the code I have used. I then paste it into cell B7 in Worksheet2 which will never change.
This is my formula. I get the error at line ActiveSheet.Paste
Sub Test()
Application.ScreenUpdating = False
For Each Cell In Sheets("Sheet1").Range("A:A")
If Cell.Value = "Oil Production" Then
ActiveSheet.Cells.Select
Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("B7").Select
ActiveSheet.Paste
End If
Next
End Sub
resize the area:
Sub Test()
Dim MyRowCount As Long, MyColCount As Long
Application.ScreenUpdating = False
For Each Cell In Sheets("Sheet1").Range("A1:A" & Range("A" & Rows.count).end(xlup).row) 'This make it poll the used data rather than the whole column
If Cell.Value = "Oil Production" Then
ActiveSheet.Cells.Select
With Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).column))
.Copy
MyRowCount = .Rows.Count
MyColCount = .Columns.Count
End With
Sheets("Sheet2").Select
Range("B7").Resize(MyRowCount, MyColCount).PasteSpecial xlPasteAll
'Do you need to flick back to Sheet1 after pasting?
End If
Next
End Sub
Also I took out a bunch of selects for you.
Range("A1").Select
Selection.Paste
can be written as
Range("A1").PasteSpecial XLPasteAll
You can chop out most selects this way, you can see I have also done it with the Range you are copying
Need a code snippet; if some kind guru could help, please. I need to express the following cursor movement sequence in XL VBA.
After entering a formula in cell A1 (Col-A is otherwise empty), I need to copy the formula to all cells in the range A1:AN, where N is the last row of the table.
I recorded a macro to do the following (code below):
1) enter the formula (in Cell A1)
2) copy the formula
3) go Right to B1
4) go to the last populated cell in Col-B [using Ctrl+Down] (easiest way to find the last row)
5) go Left to Col-A
6) select all cells from current to A1
7) paste the formula to the selection
The part I need help with is a way to capture the cell address in step 5 as a variable so that I can use this macro on a series of files having a variable number of rows.
Here is the recorded macro. In this example, the last row in the table is 7952.
Sub test()
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],3)"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveCell.Offset(-7951, 0).Range("A1:A7951").Select
ActiveCell.Activate
ActiveSheet.Paste
End Sub
Kindly copy the below code to the worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If Target.Address = "$A$1" And Target.Count = 1 And Target.HasFormula Then
Dim lastRow As Long
lastRow = Range("A65000").End(xlUp).Row
Dim rng As Range
Set rng = Range("A2:A" & lastRow)
' Target.Copy
' rng.PasteSpecial xlPasteFormulas
'OR
' rng.Formula = Target.Formula
' OR
rng.FormulaR1C1 = Target.FormulaR1C1
End If
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
I'm not sure if your end cell is always going to be the same, meaning you may want to "un" hard code the rows, but you could try this.
Sub test()
Range(Cells(1, 1), Cells(7951, 1)) = "=LEFT(RC[1],3)"
End Sub
If you are always going to put equations in column A based on the number of rows used in column B you could try this.
Sub test()
' dimension the variable type
Dim lastRow As Long
' select cell "B1"
Cells(1, 2).Select
' jump to the last consecutive row in column B
Selection.End(xlDown).Select
' collect the row number into a variable
lastRow = ActiveCell.Row
' paste the equation into the variable length range
Range(Cells(1, 1), Cells(lastRow, 1)) = "=LEFT(RC[1],3)"
End Sub
Thanks Todd and user2063626,
I decided on a simpler approach. I only needed to obtain the last row in order to set my selection area; the number of the last row is not used in the actual values to be written. The files to be manipulated are flat ascii exports; the column layout is constant, only the number of rows is variable.
After writing the formula to A1, I move down column B and test for a value one cell at a time; if TRUE, copy the formula to the left adjacent cell; if FALSE, end process.
Sub FillClientCodes()
Range("A1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],3)"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select
CheckCell:
ActiveCell.Activate
If ActiveCell.Value <> 0 Then
ActiveCell.Offset(0, -1).Select
ActiveCell.Activate
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select
GoTo CheckCell
Else: GoTo EndOfData
End If
EndOfData:
End Sub
It's not elegant - it runs slower than a single select and paste - but it works, and it will work on all the files I need to process. Thanks again.