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
Related
I wrote the code below which works fine except that it takes forever and looks as if Excel is having an epileptic seizure.
Any help with something less prehistoric would be much appreciated.
Sub Data()
Sheets("2").Unprotect "Joe"
Worksheets("3").Range("a").Copy
Worksheets("2").Range("D10").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("b").Copy
Worksheets("2").Range("L10").PasteSpecial Paste:=xlPasteValues
Worksheets("2").Range("L18").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("c").Copy
Worksheets("2").Range("D11").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("d").Copy
Worksheets("2").Range("L11").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("e").Copy
Worksheets("2").Range("D17").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("f").Copy
Worksheets("2").Range("L17").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("g").Copy
Worksheets("2").Range("D18").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("h").Copy
Worksheets("2").Range("D19").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("i").Copy
Worksheets("2").Range("L19").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("j").Copy
Worksheets("2").Range("D20").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("k").Copy
Worksheets("2").Range("E22").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("l").Copy
Worksheets("2").Range("E23").PasteSpecial Paste:=xlPasteValues
Worksheets("3").Range("m").Copy
Worksheets("2").Range("E24").PasteSpecial Paste:=xlPasteValues
End Sub
Sub Data()
Dim rng As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Sheets("2").Unprotect "Joe"
With Worksheets("2")
Set rng = Range("a")
.Range("D10").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2
Set rng = Range("b")
.Range("L10").Resize(rng.Rows.Count, rng.Columns.Count).Value2 = rng.Value2
'...and so on
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Note that because you're using range names for a, b, c then there is no need to qualify them with a sheetname unless they are locally scoped.
Instead of copy-pasting, you could also set the value of your destination cell equal to the value of your original cell. For example:
Worksheets("2").Range("D10").Value = Worksheets("3").Range("a").Value
To prevent the seizure like behavior in the application window of Excel, do as Excelosaurus suggested and turn off screen updating at the start of your macro. (And make sure to turn it back on at the end).
Put Application.ScreenUpdating = False at the beginning of your sub, and Application.ScreenUpdating = True at the end.
The code below works but isn't fast and I'm sure there are ways it could simplified. I'm not a coder -- I just compiled a few samples that I found. I really don't understand the range/end/offset pieces for the pasting aspect. Here's what I'm trying to do:
1. Print the first three worksheets in the workbook
2. Create three new worksheets at the end of the workbook
3. copy and paste values, formats, and column widths to the three new worksheets from the first three.
Thanks for any help you can provide!
Option Explicit
Option Base 1
Sub Print_copy_Current_Workbook()
'Prints the current active workbook in Excel
Sheets("Draw").PrintOut
Sheets("Calculations").PrintOut
Sheets("AIN").PrintOut
Application.ScreenUpdating = False
Dim Tabs As Variant
Dim I As Byte
Tabs = Array("Draw Final", "AIN Final", "Calculations Final")
For I = LBound(Tabs) To UBound(Tabs)
Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1).Name = Tabs(I)
Next I
Sheets("Draw").Range("A1:L1000").Copy
With Sheets("Draw Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Sheets("AIN").Range("A1:L1000").Copy
With Sheets("AIN Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Sheets("Calculations").Range("A1:L1000").Copy
With Sheets("Calculations Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Suggestion below.
Also I would avoid Option Base 1 - it's rarely used, and will just cause problems later when you get used to working with zero-based arrays.
Sub Print_copy_Current_Workbook()
Dim Tabs As Variant
Dim I As Long
Application.ScreenUpdating = False
Tabs = Array("Draw", "AIN", "Calculations")
For I = LBound(Tabs) To UBound(Tabs)
Sheets(Tabs(I)).PrintOut
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = Tabs(I) & " Final"
CopyPaste Sheets(Tabs(I)).Range("A1:L1000")
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub CopyPaste(rng As Range)
rng.Copy
'this is a new sheet we're pasting to, so why not just Range("A1") ?
With Sheets(rng.Parent.Name & " Final").Range("iv1").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
End With
End Sub
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
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.