I have a rather simple vba script that copies trasposed values from a range in a sheet to another, here is the relevant code:
wb.ActiveSheet.Range("D2", "D32").Copy
cwb.ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteValues, Transpose:=True
The source range is unformatted text (no control over this) but it is a time (xx:xx) while the destination is appropriately pre-formatted as a time (xx:xx).
It seems that the values in the destination range are treated as plain strings as opposed to being formatted according to the specified rule. As soon as I select a cell and press enter the formatting is applied.
How can I trigger the same behavior right when I'm pasting the range in vba?
The user shouldn't be required to confirm every cell.
I should add that this causes some calculations to fail, too, because to excel those are not numbers.
In your case the regular Copy >> PasteSpecial will not work, you need to convert a time entered as a String to time format, which actually a decimal value from 0 to 1. You can achieve it using the TimeValue function.
So you'll need to Set a CopyRng object to the range you want to copy, and loop through it, each cell use the TimeValue to convert the string to a Time format.
Code
Dim CopyRng As Range
Dim i As Long
Set CopyRng = wb.ActiveSheet.Range("D2", "D32") ' <-- I would try to avoid using Active Sheet
' loop through all cells in your range
For i = 1 To CopyRng.Cells.Count
cwb.ActiveSheet.Range("B10").Offset(0, i - 1).Value = TimeValue(CopyRng.Cells(i, 1).Value)
Next i
The previous answer from Shai Rado works, but has the major throwback, that it that it has i reading + i writing operations. I also propose using the TimeValuefunction, but with only one read/write as follows:
Function transposeAsTime(SourceRng As Range, TargetRng As Range)
Dim x As Variant
Dim y As Variant
x = SourceRng
ReDim y(1 To 1, 1 To UBound(x, 1))
For i = 1 To UBound(x, 1)
y(1, i) = TimeValue(x(i, 1))
Next i
TargetRng.Resize(1, 1).Resize(1, UBound(y, 2)) = y
End Function
Execute with:
Sub test()
transposeAsTime ThisWorkbook.Sheets(1).Range("D2:D32"),
ThisWorkbook.Sheets(1).Range("D10")
End Sub
You may try to add the code below (not tested):
cwb.ActiveSheet.Range("B10").PasteSpecial Paste:=xlPasteFormats, Transpose:=True
Related
Concept:
Entire Rows are deleted through a macro based off parameters which are represented as an excel formula by the user. The idea here is that a user can use Boolean formulas that they're already familiar with to evaluate values in a range (read the "Process" below for further clarification).
Process:
A user clicks on a button which shows a form. This form contains two input fields (or parameters); "Column" and "Formula". The "Column" is the range for which the macro will be cycling through (let's say $A:$A). The "Formula" is an Excel based formula represented as such, in the user parameter field ie =OR(A1="X",A1="Y"). However, I've instructed the user to replace any instance of A1 with rng. I've requested the user to do this because the idea here is that I would replace rng with a changing variable in VBA that cycles through all the cells specified in the "Column" parameter.
Problem:
I'm not aware of any way to replace the rng representation within the Excel formula with a range variable in VBA.
Update 4-7-17
Thank you all for your responses but I'm pretty certain my problem is getting lost in translation. I'm aware this is my fault, since I didn't provide any code for analysis. Unfortunately, therein lies the issue. I don't know what to write. I'm going to do my best to write some code (that I know is wrong) which will hopefully convey what I'm trying to accomplish.
Sample Code 4-7-17
Sub SampleCode()
Dim wRng As Range
Set wRng = Range("A1:A26") 'Let's assume that the values in this range are the
' letters of the alphabet
Dim Counter As Integer
'Cell "B2" will contain a formula that the user has entered
'which is: =OR(rng="X",rng="M")
'Obviously the formula returns an error in excel (#NAME? to be
'exact) but that's understood.
Dim wFormula As String
wFormula = Range("B2").Formula
Dim rng As Range 'This variable "rng" is what is represented in the
'formula that was written in Range("B2")
'*** This is where I get stuck. I know I'm missing code here to
'be able to proceed with my routine below.
'code
'code
'code
Counter = wRng.Rows.Count
For i = 1 To wRng.Rows.Count
Set rng = Cells(Counter, 1)
If wFormula = True Then
rng.EntireRow.Delete
End If
Counter = Counter - 1
Next i
'The ending result should be that row 24 was deleted because it contained
'the letter "X" and row 13 was deleted because it contained the letter "M"
'
'The objective of this code is to use any Excel formula which evaluates out
'to a True or False value.
End Sub
Hey Jon first you need to declare a Variable of relevant data type, then pass value from Range & finally use where you wish to, like,
Dim Src As Variant
Src= Sheets( "Sheet3" ).Range( "A2:A9" ).Value
Hey John this code will help you to get the solution,
Public Sub ProcessData()
Const TEST_COLUMN As String = "A"
Dim Lastrow As Long Dim i As Long
Application.ScreenUpdating = False
With ActiveSheet
Lastrow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, TEST_COLUMN).Value2 Like "AU" Or _ Cells(i, TEST_COLUMN).Value2 Like "AZ" Then
.Rows(i).Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
[Latest finding] I found that value(11) can actually copy formulas sometimes, but not always. Formulas like sumproduct and sumif cannot be copied, but simple arithmetic operations can be copied. This is so strange! I still cannot figure out why.
I know that if I want to copy values only, the fastest way is
Range("A1").Value = Range("A2").Value
If I want to copy formatting and values, the fastest way is
Range("A1").Value(11) = Range("A2").Value(11)
If I want to copy formulas, the fastest way is
Range("A1").Formula = Range("A2").Formula
What if I want to copy both the formula and formatting? (I have many formatting in that cell, like conditional formatting, bold, underline, alignment, number display format, border style, etc., so it is not practical to transfer each of the styles one at a time.)
I just found out a simple answer.
Range("A1").Value(11) = Range("A2").Value(11)
Range("A1").Formula = Range("A2").Formula
Since value(11) fails when copying some complicated formulas (I don't know why, should be a bug in Excel), I added the second line to paste the formula again. This should ensure all formulas are copied correctly.
To copy formulas with the formatting in the source range and keep the formulas relative (e.g. like using Ctr-C and Ctr-V) use this copy and paste method:
Range("A1").Copy Range("A2")
How about a sub like this:
Sub copyFormattingAndFormulas(source As Range, target As Range)
Dim sourceCell, targetCell As Range
Dim i, j, lastRow, lastColumn As Integer
lastRow = source.rows.count + source.row - 1
lastColumn = source.columns.count + source.Column - 1
For i = source.row To lastRow
For j = source.Column To lastColumn
Set sourceCell = Cells(source.row + i - 1, source.Column + j - 1)
Set targetCell = Cells(target.row + i - 1, target.Column + j - 1)
targetCell.value(11) = sourceCell.value(11)
targetCell = sourceCell.Formula
Next
Next
End Sub
All it does is do both the things you showed in the question (good to know about .value(11)!) in a loop for a specified range.
I have a piece of "crude" code which copies some data from one sheet to Another, and the sheet-name from which the data is copied can be found in a cell. However, the number of sheets are now growing, and I have created a dynamic named range for the sheetnames, and would like to perform the following code for all the sheets in the dynamic range. My code looks like this:
Calculate
' get the worksheet name from cell AA3
Worksheets(Range("AA3").Value).Activate
' Copy the data
Range("A1:A1500").Select
Selection.Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Now, I would like to have something like a loop with reference to the dynamic range but I am unable to get it to work as VBA really is not my cup of tea...So, instead of referencing AA3, AA4 etc I would like to referebnce the named range which contains the data of AA3, AA4....AAx. The named range might also contain blank cells, as it is the result of an Array formula in AA3....AA150.
Thank you!
/Fredrik
The following code should work for you. I assumed that the named range (i called it copysheets) is in the active workbook (scope workbook).
Sub copySheets()
Dim sheetName As Range
Dim copyRange As Range
Dim destinationRange As Range
For Each sheetName In Range("copysheets")
If sheetName.Value <> "" And sheetName.Value <> 0 Then
Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")
Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
copyRange.Copy
destinationRange.PasteSpecial xlPasteValues
End If
Next
End Sub
Dim myNamedRng as Range, cell as Range
'...
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range
With Sheets("Artiklar")
For Each cell In myNamedRng
If cell.Value <>"" Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value
Next cell
End With
The following example loops through each cell in a named range by
using a For Each...Next loop. If the value of any cell in the range
exceeds the value of Limit, the cell color is changed to yellow.
vba
Sub ApplyColor()
Const Limit As Integer = 25
For Each c In Range("MyRange")
If c.Value > Limit Then
c.Interior.ColorIndex = 27
End If
Next c
End Sub
Source
So you might start off with something like this:
Calculate
Dim NextRow As Range
' get a range object from the named range
For Each c In Range("[File.xls]Sheet1!NamedRange")
' Copy the data
Worksheets(c.Value).Range("A1:A1500").Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Activate
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial xlPasteValues
Next c
You'll notice that I was a bit more explicit with how the named range is being referred to - the requirement here might vary depending on how you declared the range to begin with (what its scope is), but the way I did it will most likely work for you. See the linked article for more information about scope of named ranges.
-= Problem Solved =-
Thank you all for your contribution to my question! All the answers that I received has helped me refine my code, which is now functioning properly!
Regards,
Fredrik
Looking for some help with a VBA function
I have data on two sheets I need to perform an index match on.
The data size will vary every time the compare is run.
I have coded the VBA to call the data and populate both sheets but running the comparison is causing a problem.
I have created the below function, its running without error but not populating the formula in cell starting J2 to end of the J range.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J:J").FillDown
End With
End Sub
Any help would be greatly appreciated.
W
Image after updated code applied
You were writing the formula to an array variable, not a cell, then you tried to fill the entire column by using J:J. This means it was trying to fill the entire column with the contents of cell J1, the top cell, not J2.
Here is the code with corrections.
Sub FormulaFill()
With ThisWorkbook.Sheets("Export Worksheet")
.Cells(2, 10).Formula = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range(.Cells(2, 10), .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10)).FillDown
End With
End Sub
The .Cells(.Rows.Count, 9).End(XlUp).Row determines the last filled row of column 9 (I) and the code uses that number in the range to use for the autofill of column 10 (J)
It's because you're not filling the cell with the formula.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J1").Forumla = strFormulas(1)
.Range("J:J").FillDown
End With
End Sub
I've looked around the forum and played with various options but not found a clear match for my problem:
My task is to copy data from a worksheet (called “workorders”) to a second worksheet (called “Assignments”). The data to be copied is from the “workorders” worksheet starting at cell range “E2, P2:S2”; and also copied from each row (same range) until column “P” is empty – (the number of rows to be copied can vary each time we need to run this macro so we can’t select a standard range) . Then pasted into the “Assignments” worksheet, starting at cell “A4”. I’ve used the forum so far to successfully copy a single row of date (from row 2) – I admit that’s the easy part, and I’ve used various versions of code to achieve this.
I’ve also tried some code (which I found via watching a youtube clip and modifying http://www.youtube.com/watch?v=PyNWL0DXXtQ )to allow me to run a loop which repeats the copy process for each required row in the “workorders” worksheet and then pastes the data into the “assignments” worksheet- but this is where I am not getting it right, I think I’m along the right lines and think I’m not far off but any help would be very useful.
Code examples below (first 2 only copy first row, 3rd example is where I’ve tried to loop and copy multiple rows:
Sub CopyTest1()
' CopyTest1 Macro
'copy data from workorders sheet
'Worksheets("workorders").Range("E2,P2,Q2,R2,S2").Copy
Worksheets("workorders").Range("E2, P2:S2").Copy
'paste data to assignments sheet
'sheets("assigments dc").Range("A4").Paste
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Sub CopyTest2()
Sheets("workorders").Range("e2,p2,q2,r2,s2").Copy Sheets("assigments dc").Range("a4")
End Sub
Sub CopyTest3()
Dim xrow As Long
'Dim xrow As String
xrow = 2
Worksheets("workorders").Select
Dim lastrow As Long
lastrow = Cells(Rows.Count, 16).End(xlUp).Row
Do Until xrow = lastrow + 1
ActiveSheet.Cells(xrow, 16).Select
If ActiveCell.Text = Not Null Then
'Range("E2,P2,Q2,R2,S2").Copy
'Selection = Range("E2,P2,Q2,R2,S2").Copy
'Cells(xrow, 5).Copy
Cells(xrow, 5).Copy
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("workorders").Select
End If
xrow = xrow + 1
Loop
End Sub
Try this:
Sub LoopCopy()
Dim shWO As Worksheet, shAss As Worksheet
Dim WOLastRow As Long, Iter As Long
Dim RngToCopy As Range, RngToPaste As Range
With ThisWorkbook
Set shWO = .Sheets("Workorders") 'Modify as necessary.
Set shAss = .Sheets("Assignments") 'Modify as necessary.
End With
'Get the row index of the last populated row in column P.
'Change accordingly if you want to use another column as basis.
'Two versions of getting the last row are provided.
WOLastRow = shWO.Range("P2").End(xlDown).Row
'WOLastRow = shWO.Range("P" & Rows.Count).End(xlUp).Row
For Iter = 2 to WOLastRow
Set RngToPaste = shAss.Range("A" & (Iter + 2))
With shWO
Set RngToCopy = Union(.Range("E" & Iter), .Range("P" & Iter & ":S" & Iter))
RngToCopy.Copy RngToPaste
End With
Next Iter
End Sub
Read the comments first and test.
Let us know if this helps.
From what I see, you are only copying the cell in Column E. You could correct this by replacing Cells(xrow, 5).Copy with
Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Copy
However, using Select and Copy are not ideal. Instead, you can assign the value of the range directly:
Sheets("Assignments DC").Range("A4").Value = Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Value
More info on the Union method and why using Select is bad.
Is it even possible to run a line like this?
Worksheets("workorders").Range("E2, P2:S2").Copy
Each time I try different ways to copy/select a range which contains in my case, A3 and the range A34:C40 ("A3, A34:C40").Copy i get an error saying theres to many parameters.. Could this be because I'm running excel 2007?
Any tips or help would be greatly apreciated! :)