I got no error with the line below where I copy the values from one range to another:
ThisWorkbook.Sheets("Output").Range("F" & lastRowOutput + 1 & ":" & "M" & lastRowOutput + 1).Value = projectWb.Sheets("Beställningar").Range("B" & row & ":" & "I" & row).Value
But when I try to do the same with the NumberFormat I get an error message:
ThisWorkbook.Sheets("Output").Range("F" & lastRowOutput + 1 & ":" & "M" & lastRowOutput + 1).NumberFormat = projectWb.Sheets("Beställningar").Range("B" & row & ":" & "I" & row).NumberFormat
What I really want to achieve is to copy values from one range to another, and retain the text values as text and number values as numbers.
Try this one:
projectWb.Sheets("Beställningar").Range("B" & Row & ":" & "I" & Row).Copy
ThisWorkbook.Sheets("Output").Range("F" & lastRowOutput + 1).PasteSpecial xlPasteValuesAndNumberFormats
You can get the general idea by simply recording a macro:
Range("C12:C13").Select
Selection.Copy
Range("G12").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Related
I currently have this code that works to insert full rows. However, I was hoping to limit the inserting of the row to columns A:J.
Bonus points to see who can help me figure out that if I delete column C why my current code doesn't work?
I tried to add .resize(1,10) but for some reason I keep getting errors, maybe the location in which I try to add this function. Any guidance/help is appreciated as always!
Here is my current code:
VBA Code:
Sub Add_Job()
Dim act As Worksheet
Set act = ThisWorkbook.ActiveSheet
bot_row = act.Range("Z1")
act.Rows(bot_row & ":" & bot_row + (5)).Insert Shift:=x1ShiftDown
act.Range("A3:J8").Copy
act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormats
act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormulas
Range("B" & bot_row & ":B" & bot_row + (5)).ClearContents
Application.CutCopyMode = False
End Sub
Edit: Updated Code that works now. However, I still don't understand if I delete column C, why it throws an error?
Dim act As Worksheet
Set act = ThisWorkbook.ActiveSheet
bot_row = act.Range("Z1")
act.Range("A" & bot_row & ":J" & bot_row + (5)).Insert Shift:=xlShiftDown
act.Range("A3:J8").Copy
act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormats
act.Range("A" & bot_row & ":J" & bot_row + (5)).PasteSpecial xlPasteFormulas
Range("B" & bot_row & ":B" & bot_row + (5)).ClearContents
Application.CutCopyMode = False
I recorded a macro, which I want to modify in order to use it automatically in multiple ranges in the Excel worksheet. Here's the code:
Sub Macro1()
For i = 6 To 22370 Step 5
ActiveWorkbook.SaveAs Filename:= _
"tute.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Rows(i:i).Select
Range("D" & i).Activate
Selection.Insert Shift:=xlDown
Range("D" & i).Select
ActiveCell.FormulaR1C1 = "xyz"
Range("A"&"i-1":"C"&"i-1").Select
Selection.Copy
Range("A" & i).Select
ActiveSheet.Paste
Range("E" & i).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C*R[4]C"
Range("E" & i).Select
Selection.AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
Range("E"&i:"AO"&i).Select
Range("D" & i).Select
Next
End Sub
I would like to use the variable "i" to call specific rows, as in the case of Rows(i:i).Select or a range such as Range("E"&i:"AO"&i).Select, but I get an error message: "Expected: list separator or )"
Can you help pls?
Thank you in advance
Besides my comments above, here's a quick rewrite to get rid of all of the superfluous .Activate and .Select lines. Those are for humans, VBA doesn't need to select something before acting on it. It can just act on it directly.
Sub Macro1()
'This line shouldn't be in your for loop otherwise you save this workbook like 4000 times
ActiveWorkbook.SaveAs Filename:="tute.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
For i = 6 To 22370 Step 5
'No reason to select the row since we just go ahead and activate a particular cell immediately afterwords
'Rows(i:i).Select
'No reason to "Activate" the cell. We can just shift it down without highlighting the thing for the user
'Range("D" & i).Activate
Range("D" & i).Insert Shift:=xlDown
'No need to .Select. Just change the formula directly.
'Range("D" & i).Select
Range("D" & i).FormulaR1C1 = "xyz"
'Again, no need to .Select. And we can do the copy/paste in one line
'Range("A"&"i-1":"C"&"i-1").Select
'Selection.Copy
'Range("A" & i).Select
'ActiveSheet.Paste
Range("A" & i-1 & ":C" & i-1).Copy Destination:=Range("A" & i)
'Removing superfluous select again
'Range("E" & i).Select
'Also superfluous code that isn't needed
'Application.CutCopyMode = False
'Application.CutCopyMode = False
Range("E" & i).FormulaR1C1 = "=R[-1]C*R[4]C"
'Range("E" & i).Select
Range("E" & i).AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
'Superfluous selects
'Range("E"&i:"AO"&i).Select
'Range("D" & i).Select
Next
End Sub
And then cleaned up to remove all of that:
Sub Macro1()
ActiveWorkbook.SaveAs Filename:="tute.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
For i = 6 To 22370 Step 5
'Shift column D for this line down a row (add a new empty cell for this line)
Range("D" & i).Insert Shift:=xlDown
'Change the value to xyz of column D for this line (the new cell)
Range("D" & i).FormulaR1C1 = "xyz"
'Copy three lines in column A:C and paste 1 line down
Range("A" & i-1 & ":C" & i-1).Copy Destination:=Range("A" & i)
'Change the formula in column E for this line
Range("E" & i).FormulaR1C1 = "=R[-1]C*R[4]C"
'Not sure if this is what you are actually after here. Perhaps that should be `Range("E" & i & ":AO" & i)?`
Range("E" & i).AutoFill Destination:=Range("E37:AO37"), Type:=xlFillDefault
Next
End Sub
I would like to copy and paste a formula from column P to column C using a loop in VBA. The code should only copy and paste for numeric values in column P and do nothing when cell is blank.
Sub TestAll()
For i = 10 To 91
Worksheets("Hello").Range("P" & i).Formula = "=" & "MRound(" & Range("C" &
i).Value & "+$C$7" & ",0.125)"
Next i
Application.CutCopyMode = False
Range("P10:P91").Select
Selection.Copy
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Since you're already using a for loop, you can directly copy the data there.
To check if it's a numeric data, you can use the IsNumeric( Expression ) function and the code could be something like this:
Sub TestAll()
For i = 10 To 91
Worksheets("Hello").Range("P" & i).Formula = "=" & "MRound(" & Range("C" & i).Value & "+$C$7" & ",0.125)"
If (IsNumeric(Worksheets("Hello").Range("P" & i).Value)) Then
Worksheets("Hello").Range("C" & i).Value = Worksheets("Hello").Range("P" & i).Value
End If
Next i
End Sub
Note: Please note that this check is redundant, since the formula
will give you always the same result over and over.
Hope this help.
Sub TestAll()
For i = 10 To 91
If (IsEmpty(Worksheets("Hello").Range("C" & i).Value))
Then
Worksheets("Hello").Range("P" & i).Value = ""
ElseIf (IsNumeric(Worksheets("Hello").Range("C" &
i).Value)) Then
Worksheets("Hello").Range("P" & i).Formula = "=" &
"MRound(" & Range("C" & i).Value & "+$C$7" & ",0.125)"
Else
Worksheets("Hello").Range("P" & i).Value =
"CALIBRATED"
End If
Next i
Application.CutCopyMode = False
Range("P10:P91").Select
Selection.Copy
Range("C10").Select
Selection.PasteSpecial
Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
I am attempting to pad an XLS cell via VBA & XLS Formula but I am stumbling:
Example: I want to append " - Test" to the contents of Cell AC2 via a formula, then paste that formula to all the remaining rows in Col AC:
lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
strTest = " - Test"
'append
Range("AC2:AC2").Formula = "=AC2.value & value(strTest)"
'then cut and paste
Range("AC2").Select
Selection.Copy
Range("AC2:A" & lastRow).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
I am guessing I need to adjust the syntax of the formula to append. I've tried several variants without success.
Any suggestions?
Note: the following formula works, but only in the first row. Copy & Paste simply copies the VALUE from X2 into subsequent rows, not the formula:
Range("X2:X2").Formula = Range("AC2:AC2").Value & strTest
Range("X2").Select
Selection.Copy
Range("X2:X" & lastRow).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
To append strTest to the cell values, you can use:
With Range("X2:X" & lastRow)
.Value2 = .Worksheet.Evaluate("Index(" & .Address & "&""" & strTest & """,)")
End With
I think instead of this:
Range("AC2:AC2").Formula = "=AC2.value & value(strTest)"
You want this:
Range("AC2:AC2").Formula = "=AC2.value & value(" & strTest & ")"
Sub AutofillData()
Dim wkbkSource As Workbook
Dim strPath As String
Dim myRange As Range
Dim i As Integer
Dim c As Range
Dim wkbkTarget As Workbook
Application.ScreenUpdating = False
strPath = "\\temp\"
Set wkbkA = ThisWorkbook
Set wkbkB = Workbooks.Open(strPath & Range("E8").Value)
Set myRange = wkbkA.Sheets("Stand-up Request").Range("B13:B25")
offs = 0
For Each c In myRange
i = c.Value
wkbkB.Worksheets("Main Data").Range("D" & i & ":AH" & i).Copy
wkbkA.Sheets("Stand-up Request").Range("C13").Offset(offs, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
offs = offs + 1
On Error Resume Next
Next
wkbkB.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
If you don't mind the column order, you should only change one row:
wkbkB.Worksheets("Main Data").Range("D" & i & ":I" & i & ",K" & i & ",O" & i & ",AG" & i & ",AH" & i & ",AA" & i).Copy
Note that this way AA gets pasted before AG. If you mind the column order, you should split your range and copy/paste them separately:
wkbkB.Worksheets("Main Data").Range("D" & i & ":I" & i & ",K" & i & ",O" & i & ",AG" & i & ",AH" & i).Copy
wkbkA.Sheets("Stand-up Request").Range("C13").Offset(offs, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
wkbkB.Worksheets("Main Data").Range("AA" & i).Copy
wkbkA.Sheets("Stand-up Request").Range("C13").Offset(offs, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Note that this is a static code, if you change the columns to copy, you should also set the column value of the second paste's offset accordingly. If you want a dynamic code, you should create another range object that you will copy and you can get the dimensions of that range.
Also it might be better avoiding copy/paste altogether, using code like:
wkbkA.Sheets("Stand-up Request").Range("C13").Offset(offs, 0).Resize(1, 6).Value = wkbkB.Worksheets("Main Data").Range("D" & i & ":I" & i).Value
But it needs to be done for each sub-range, so it gets more complicated.
Also note that your code worked fine for me on ActiveSheet without On Error Resume Next, so you better check your code again :)