I'm beginner, and I want to ask something about my code. why paste column width wont work on VBA EXCEL??
Here's my code. thank you.
Sub merge()
Dim P As Integer
On Error Resume Next
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "RAW"
Sheets(1).Activate
ActiveSheet.UsedRange.Select
Selection.Copy Destination:=Sheets("RAW").Range("A1")
Sheets("RAW").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
For P = 2 To Sheets.Count - 1
Sheets(P).Activate
Range("A5").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("RAW").Range("A1000000").End(xlUp)(2)
Next
End Sub
:) In your code you are referencing to a range A1, which is already in "A:Z".
If you want to make the columns B to Z equal to the column A in width, use the following code.
Columns("B:Z").columnwidth = columns("A:A").columnwidth
Related
I have 600k rows and want to remove starting and trailing whitespace. I have the following, but it is rather slow:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("D1").Select
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])"
Range("D1").Select
Selection.AutoFill Destination:=Range("D1:D4")
Range("D1:D4").Select
Columns("D:D").Select
Selection.Copy
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C1").Select
End Sub
Is there a way that I can apply the function on itself. I would like to avoid running a function in an empty column, then copying the values to the original column.
I tried VBA to fill formula down till last row in column as well as to speed up the formula. I have a few columns to do this with, and wonder if it is possible to only work on column C and trim the whitespace without the extra computations.
Thanks
This does not use a second column and does all the values in Column C. It moves the values to an array, iterates the array and trims the excess space and overwrites the values in C with the array.
Sub macro1()
Dim rng As Variant
Dim ws As Worksheet
Dim i As Long
Set ws = Worksheets("Sheet1") 'Change to your sheet name.
With ws
rng = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp)).Value
For i = LBound(rng) To UBound(rng)
rng(i, 1) = Application.Trim(rng(i, 1))
Next i
.Range("C1", .Cells(.Rows.Count, 3).End(xlUp)).Value = rng
End With
End Sub
Change the code like this so you don't use Select. Using Select and Selection slows everything down horribly.
Sub Macro1()
Range("D1").FormulaR1C1 = "=TRIM(RC[-1])"
Range("D1").AutoFill Destination:=Range("D1:D4")
Columns("D:D").Copy
Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("D:D").ClearContents
End Sub
I'm recording a macro and need some help. I'd like copy and paste the values from the column G of the "SalesData" worksheet into cells A2, A12, A22 etc of the "Results" worksheet until there's no more values in the column G.
VBA is pretty new to me, I've tried using Do/Until, but everything crashed. Could you please help me? Please see the code I've recorded below. Thank you!
Sub(x)
Sheets("SalesData").Select
Range("G2").Select
Selection.Copy
Sheets("Results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A12").Select
Sheets("SalesData").Select
Range("G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A22").Select
Sheets("SalesData").Select
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A32").Select
Sheets("SalesData").Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
I prefer to find the last cell in the column first then use a For loop.
Since you are only doing the values we can avoid the clipboard and assign the values directly.
Since you paste is every 10 cells we can use a separate counter to move down 10 each loop.
Sub x()
Dim ws As Worksheet
Dim lst As Long
Dim i As Long, j As Long
'use variable to limit the number of times we type the same thing
Set ws = Worksheets("Results")
'First row of the output
j = 2
'using with and the "." in front of those items that belong to it also limits the typing.
With Worksheets("SalesData")
'Find the last row with values in Column G
lst = .Cells(.Rows.Count, 7).End(xlUp).Row
'Loop from the second row to the last row.
For i = 2 To lst
'Assign the value
ws.Cells(j, 1).Value = .Cells(i, 7).Value
'Move down 10 rows on the output
j = j + 10
Next i
End With
End Sub
here is the same thing but using range variables
Sub x()
Dim src As Range
Dim dst As Range
Set dst = Worksheets("Results").Range("a2") ' point to top cell of destination
With Worksheets("SalesData")
For Each src In Range(.Cells(2, "g"), .Cells(.Rows.Count, "g").End(xlUp)) ' loop through used cell range in column G
dst.Value = src.Value
Set dst = dst.Offset(10) ' move destination pointer down 10 rows
Next src
End With
End Sub
This is just for fun/practice for another way to do it:
Sub copyFromG()
Dim copyRng As Range, cel As Range
Dim salesWS As Worksheet, resultsWS As Worksheet
Set salesWS = Sheets("SalesData")
Set resultsWS = Sheets("Results")
Set copyRng = salesWS.Range("G2:G" & salesWS.Range("G2").End(xlDown).Row) ' assuming you have a header in G1
For Each cel In copyRng
resultsWS.Range("A" & 2 + 10 * copyRng.Rows(cel.Row).Row - 30).Value = cel.Value
Next cel
End Sub
This code is a bit complex but the problem with it is the second and third time it is run it will start to lose columns on the "Base434" worksheet that it pulls information from. I tried a quick fix of adding "Range("A1").Select so that anything previously highlighted couldn't throw it off but it keeps ditching the 20th row which is column "T". I have left all of the code below in hope that someone can find my bug. I just cannot sort it.
Essentially this code sorts set fields of data on an imported worksheet called "Base434", copies specific fields to another page which has some embeded formulas then checks to see if the worksheet "NoStdHC" exists. If it doesn't it will create said worksheet and add the header. Then move to the filtered worksheet called "Base434" and copy all visible cells in that worksheet. It will then paste those in the first available cell in column A of "NoStdHC". My issue is after running this once it refuses to copy the final column on the next "Base434" sheet that has been imported. Can anyone find the fault in my code? Yes I know a lot of this could be condensed if I were better at coding but I would prefer to understand what the code is doing which is why I have it written this way.
Sub NoStdHC()
'
' NoStdHC Macro created by
'
'
Application.ScreenUpdating = False
Sheets("Base434").Select
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=15
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5", _
Operator:=xlAnd
Columns(11).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Processing").Select
Range("AC1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(C[26])"
Range("e5").Select
ActiveCell.FormulaR1C1 = "=SUM(C[24])"
Range("C8").Select
Sheets("Base434").Select
Dim wsTest As Worksheet
Const strSheetName As String = "PR0OnStd"
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
Sheets("Base434").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("PR0OnStd").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Columns.AutoFit
Range("A2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
End If
Sheets("Base434").Select
Range("a1").Select
Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("PR0OnStd").Select
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub'
As commented by #A.S.H avoid using Select/Activate/ActiveCell if at all possible. Ranges should be qualified by using their sheet names. With...End With constructs achieve both of these goals. The With statement allows you to perform a series of statements on a specified object without requalifying the name of the object.
Indentation makes code much easier to read and understand.
With the foregoing in mind I think this code is understandable
Sub NoStdHC()
Dim LastRow As Long
Dim sht As Worksheet
Application.ScreenUpdating = False
With Sheets("Base434")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5"
.Range(.Cells(2, 11), .Cells(LastRow, 11)).Copy
End With
With Sheets("Processing")
.Range("AC1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Range("C5").FormulaR1C1 = "=COUNTA(C[26])"
.Range("E5").FormulaR1C1 = "=SUM(C[24])"
End With
Dim wsTest As Worksheet
Const strSheetName As String = "PR0OnStd"
'Loop through sheets to find strSheetName
'if not found, then wsTest will be Nothing
For Each sht In ThisWorkbook.Sheets
If sht.Name = strSheetName Then
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
Exit For
End If
Next
If wsTest Is Nothing Then
'Add the sheet, set up headings, column widths and frozen pane
Worksheets.Add.Name = strSheetName
With Sheets("Base434")
.Range("A1", .Range("A1").End(xlToRight)).Copy
End With
With Sheets("PR0OnStd")
.Range("A1").PasteSpecial xlPasteValues
.UsedRange.Columns.AutoFit
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
End If
With Sheets("Base434")
.Range(.Cells(2, 1), .Cells(LastRow, 2).End(xlToRight)).Copy
End With
With Sheets("PR0OnStd")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
If you wanted to write write code you can easily understand you wouldn't write code like this:-
Sheets("Base434").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
This is what your code says, translated into plain language:-
Look at sheet "Base434"
Look at cell A1 (implied: in that sheet)
Look at what you are looking at and extend your view to the last ??? right
(This is where the mistake is)
Copy what you are looking at.
Now, surely, if you wanted to understand what all this looking is aiming to do you might express the idea somewhat like this:-
Copy the cells in Row 1 of Sheet "Base434" from A1 to the end of the row.
With this kind of approach you would end up with code like this:-
Dim RangeToCopy As Range
Dim Cl As Long ' the last used column
With Worksheets("Base434")
Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set RangeToCopy = .Range(.Cells(1, 1), .Cells(1, Cl))
End With
MsgBox "Range to copy = " & RangeToCopy.Address
RangeToCopy.Copy
Would you say that this code is harder to read and understand than your version? Well, it has three advantages, even if it is. One, it doesn't have the fault that yours has. Two, it never got near to wanting to make the mistake that your approach made. Three, whatever errors it might still contain are easy to find and quick to eliminate.
Besides, it runs faster.
I have 50 worksheets in a workbook. columns a,b,c,d are same as columns e,f,g,h, but both sets might have different number of rows/observations. I need to consolidate all in a single sheet having only 3 columns. I need to append the column names, start copying and pasting (values) from 3rd row onwards (till end of data). I tried recording a macro too but in that case, I have to go through all the sheets manually. Can someone lead me to the right direction? I'm very new to VBA and a little help will be much appreciated. My recorded macro for copying 2 sheets goes like this:
Sheets("page 9").Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A67").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 9").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A132").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("A65").Select
Selection.End(xlUp).Select
Range("A3:D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Range("A197").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("page 10").Select
Range("E3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlUp).Select
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Size"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Discount"
Range("A1").Select
End Sub
I doubt that anyone can decypher this code; certainly I lack the ability.
The Macro recorder is a great way of learning the syntax of new commands but it does not produce "good" code. It does not know your objective and records every little step as you do it.
Take the time to study Excel VBA. Search the internet for "Excel VBA Tutorial" or visit a good library or bookshop and select an Excel VBA Primer. There are many to chose from so I am sure you will find something that suits your learning style. This study will quickly repay your investment.
Look through the excel-vba questions on StackOverflow. Many, perhaps most, will be of no current interest to you. But some will show techniques you did not know about but which will be useful. Perhaps the most difficult aspect of learning VBA is discovering what is possible. Once you know statement X exists, you can look it up and study its syntax and functionality.
Below are four macros that demonstrate relevant code. Copy them to a workbook and try them. You could not have learnt how to write these macros from a study of macro recorder output.
A This macro outputs the name of every worksheet to the Immediate Window.
Sub A()
Dim InxWsht As Long
For InxWsht = 1 To Worksheets.Count
Debug.Print Worksheets(InxWsht).Name
Next
End Sub
B This adds a new worksheet at the end of the current list and names it "Consolidate". It then creates a bold, coloured header line.
Range(CellId).Value is one way of accessing a cell's value. I have used "A1" as the cells's Id but this is just a string and could have been built at runtime. Cells(RowId, ColId).Value is another way. RowId must be a number or an integer variable. ColId can be a number, an integer variable or a column letter. I suggest you be consistent and not mix and match as I have.
I show two method of specifying a range so I can set the entire header row bold and coloured in single statements.
If I have written Range("A1").Value = "Date" this statement would have operated on cell A1 of the active worksheet. The . before Range means this statement operates of cell A1 of the worksheet identified in the With statement. Using With means I do not have to switch worksheets using Select which is a slow command.
Sub B()
Dim WhshtCons As Worksheet
Set WhshtCons = Sheets.Add(After:=Sheets(Sheets.Count))
WhshtCons.Name = "Consolidate"
With WhshtCons
.Range("A1").Value = "Date"
.Cells(1, 2).Value = "Type"
.Cells(1, "C").Value = "Size"
.Cells(1, 4).Value = "Discount"
.Range("A1:D1").Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, "D")).Font.Color = RGB(0, 128, 128)
End With
End Sub
C This outputs the value of Cell A1 of every worksheet except "Consolidate".
Sub C()
Dim InxWsht As Long
For InxWsht = 1 To Worksheets.Count
If Worksheets(InxWsht).Name <> "Consolidate" Then
With Worksheets(InxWsht)
Debug.Print "Cell A1 of Worksheet " & .Name & " contains [" & _
.Cells(1, 1).Value & "]"
End With
End If
Next
End Sub
D I will not explain this macro because it is somewhat more advanced than the others. It demonstrates moving columns of data from all the other worksheets to worksheet "Consolidate". I doubt this is close to what you seek but it demonstrates that what you seek is possible.
Sub D()
Dim ColConsCrnt As Long
Dim InxWsht As Long
Dim RowLast As Long
Dim WhshtCons As Worksheet
ColConsCrnt = 1
Set WhshtCons = Worksheets("Consolidate")
WhshtCons.Cells.EntireRow.Delete
For InxWsht = 1 To Worksheets.Count
If Worksheets(InxWsht).Name <> "Consolidate" Then
With Worksheets(InxWsht)
RowLast = .Cells(Rows.Count, "A").End(xlUp).Row
WhshtCons.Cells(1, ColConsCrnt).Value = .Name
.Range(.Cells(1, "A"), .Cells(RowLast, "A")).Copy _
Destination:=WhshtCons.Cells(2, ColConsCrnt)
End With
ColConsCrnt = ColConsCrnt + 1
End If
Next
End Sub
Welcome to programming. I hope you find it as much fun as I do.
I'm really new to programming in VBA and having a problem with this code I'm trying to write. I am wanting the code to figure out the first row in column A that is unused then copy and paste data from a different part of the sheet into that row.
Sub CopyandPaste()
Dim RowLast As Long
RowLast = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Set NewRange = ThisWorkbook.Worksheets("Sheet2").Cells(RowLast, 1)
ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
Selection.Copy
Range("NewRange").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Any help would be extremely helpful.
Try this code :
Sub CopyandPaste()
Dim RowLast As Long
ThisWorkbook.Activate
With Worksheets("Sheet2")
RowLast = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Sheets("Sheet1").Cells(8, "B").Copy Sheets("Sheet2").Cells(RowLast, 1)
End With
End Sub
I have added comments into the code explaining changes I made.
Sub CopyandPaste()
Dim RowLast As Long
Dim newRange As Range
'this works easier if I understand your intent right
'I generally use some large row number with Excel 2010
'You may ahve to make this smaller if you are in 03
RowLast = Sheets("Sheet2").Range("B99999").End(xlUp) + 1
'if you KNOW you have continuous data in this column (no spaces)
RowLast = Sheets("Sheet2").Range("B1").End(xldown) + 1
'this is slightly better way to do this
Set newRange = ThisWorkbook.Worksheets("Sheet2").Range("A" & RowLast)
'don't do this
'ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
'Selection.Copy
'do this instead
Sheets("Sheet1").Range("B8").Copy
newRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'you were attempting to use a variable name (newrange) as a
'name of a named range in the Excel sheet
'use the variable range itself (as above)
End Sub