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
Related
Writing macros to copy cells in a different workbook in a specific format.Getting error at different lines everytime I run the code
I tried with unhide cells, selection
For i = 1 To lastrow
If IsEmpty(ThisWorkbook.Sheets("Summary").Range("A" & i).Value) = False Then
If ThisWorkbook.Sheets("Summary").Range("A" & i).Font.Bold = True Then
'Range("A" & i).Copy Range("B" & i)
Set BoldTitle = ThisWorkbook.Sheets("Summary").Range("A" & i)
x = i
Else
ws.Range("A" & i).Value = "Winter I"
BoldTitle.Copy
ws.Range("B" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("A" & i).Copy
ws.Range("C" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("B" & i).Copy
ws.Range("D" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("C" & i).Copy
ws.Range("E" & i).PasteSpecial xlPasteValues
ThisWorkbook.Sheets("Summary").Range("D" & i).Copy
ws.Range("F" & i).PasteSpecial xlPasteValues
End If
Else
End If
Next i
I'm pretty new to VBA and I've been trying to use a macro to paste a few formulas in cells. Problem is, everytime I do so, I get a 1004 error on the very first formula.
I strongly suspect it's because of quotes but I can't for the life of me understand what goes wrong. Would you guys have any idea ?
Sub PREF()
Dim lastrow As Long
lastrow = Range("'Extract WIN'!A" & Rows.Count).End(xlUp).Row
Dim P2 As Worksheet
Set P2 = Sheets("PRO")
Select Case MsgBox("Do you want to proceed with" & P2.[C2].Value & " ?", vbYesNo, "as datepref")
Case vbYes
Sheets("Extract WIN").Select
Range("W2" & ":" & "W" & lastrow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
Range("Y2" & ":" & "Y" & lastrow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
Range("AA2" & ":" & "AA" & lastrow).FormulaR1C1 = "=IFERROR(IF(AND(Provision!R2C3-RC[-4]<366;RC[-18]>0);RC[-18];0);TEXT(,))"
Range("AB2" & ":" & "AB" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-18];TEXT(,))"
Range("AC2" & ":" & "AC" & lastrow).FormulaR1C1 = "=IF(AND(RC[-2]=0;RC[-20]>0;RC[-4]>Provision!R2C6;ISNA(VLOOKUP(RIGHT(TEXT(RC[-25];""000#####"");4);Provision!R7C17:R101C18;1;FAUX))=FAUX);1;0)"
Range("AD2" & ":" & "AD" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-20]"
Range("AE2" & ":" & "AE" & lastrow).FormulaR1C1 = "=IFERROR(RC[-22]-RC[-4]-RC[-2];TEXT(,))"
Range("AF2" & ":" & "AF" & lastrow).FormulaR1C1 = "=IF(AND(RC[-20]>0;RC[-1]>0);ROUND(MIN(RC[-20]*12;RC[-1]);0);0)"
Range("AG2" & ":" & "AG" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-23]"
Range("AH2" & ":" & "AH" & lastrow).FormulaR1C1 = "=RC[-2]-RC[-18]"
Range("AI2" & ":" & "AI" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]-RC[-3];TEXT(,))"
Range("AJ2" & ":" & "AJ" & lastrow).FormulaR1C1 = "=IF(RC[-24]>0;ROUND(MIN(RC[-24]*12;RC[-1]);0);0)"
Range("AK2" & ":" & "AK" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-27]"
Range("AL2" & ":" & "AL" & lastrow).FormulaR1C1 = "=RC[-2]-RC[-21]"
Range("AM2" & ":" & "AM" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]-RC[-3];TEXT(,))"
Range("AN2" & ":" & "AN" & lastrow).FormulaR1C1 = "=IF(AND(RC[-16]>Provision!R2C7;RC[-28]>=0);RC[-1];0)"
Range("AO2" & ":" & "AO" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-31];TEXT(,))"
Range("AP2" & ":" & "AP" & lastrow).FormulaR1C1 = "=IF(RC[-18]=TEXT(,);0;IF(AND(X2<Provision!R2C7;RC[-3]>0);RC[-3];0))"
Range("AQ2" & ":" & "AQ" & lastrow).FormulaR1C1 = "=RC[-1]*RC[-33]"
Range("AR2" & ":" & "AR" & lastrow).FormulaR1C1 = "=IF(RC[-20]="""";RC[-5];0)"
Range("AS2" & ":" & "AS" & lastrow).FormulaR1C1 = "=IFERROR(RC[-1]*RC[-35];TEXT(,))"
Range("AT2" & ":" & "AT" & lastrow).FormulaR1C1 = "=IFERROR(RC[-6]+RC[-4]+RC[-2];TEXT(,))"
Range("AU2" & ":" & "AU" & lastrow).FormulaR1C1 = "=IFERROR(RC[-6]+RC[-4]+RC[-2];TEXT(,))"
Range("AV2" & ":" & "AV" & lastrow).FormulaR1C1 = "=IFERROR(RC[-2]-RC[-30];TEXT(,))"
Range("AX2" & ":" & "AX" & lastrow).FormulaR1C1 = "=IFERROR(RC[-13]*0,5;TEXT(,))"
Range("AY2" & ":" & "AY" & lastrow).FormulaR1C1 = "=IFERROR(RC[-4]*0,9;TEXT(,))"
Range("AZ2" & ":" & "AZ" & lastrow).FormulaR1C1 = "=IFERROR(RC[-2]+RC[-1];TEXT(,))"
Range("BA2" & ":" & "BA" & lastrow).FormulaR1C1 = "=IFERROR(RANK(RC[-1];RC:RC;0);TEXT(,))"
Columns("AA:AZ").NumberFormat = "#,##0"
Columns("W:BA").EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Range("AI2").Select
Sheets("PRO").Select
Case vbNo
P2.[C2].Select
End Select
End Sub
I'm sorry for the wall of code but I have no idea where I did something wrong, and was advised to give you guys full context
You need to replace the ";" with regular ",".
For example, take this line of code:
Range("W2:" & "W" & LastRow).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10];7;2);""/"";MID(RC[-10];5;2);""/"";MID(RC[-10];1;4)));TEXT(,))"
And change it to this:
Range(Cells(2, 1), Cells(2, LastRow)).FormulaR1C1 = "=IFERROR(DATEVALUE(CONCATENATE(MID(RC[-10],7,2),""/"",MID(RC[-10],5,2),""/"",MID(RC[-10],1,4))),TEXT(,))"
Also, keep in mind I made a few changes to this line. I changed it so that it is using Cells instead of range. I find Cells are easier to work with and provide better readability because we don't have to join any strings.
Either way is fine, it just boils down to preference.
I have workbook namely "OPTIONS", having multiple sheets. Data is in sheets no. 4 to 31; in columns A, B, C and D in different multiple rows. All 4 to 31 sheets have different names. In all 4 to 31 sheets, in column C have two names called "CE" and "PE". I want find CE name and copy data from column D ( which is in front of CE ) and paste in sames respective sheets in column F. Same find CE name copy data from column B and paste in column G to their respective sheets. Again now find PE name copy data in from column D and copied data should paste in column H to their respective sheets. Again find PE name copy data from column B and paste in column I. Paste should start from row 2 i.e. below heading.
In conclusion, available data is from 4 to 31 sheets having different names, in column A B C and D. Find two names from column C from all sheets and paste data from D to F, from B to G, from D to H and from B to I; in their respective sheets.
Thanks in advance.
I have tried code for first three sheets and its working fine. But the code will go too long. Expecting short code. I am not understanding how should I post my example code here. Someone please help.
Sub watermasa()
Dim x As String, y As String
x = InputBox("Please Enter the first name")
y = InputBox("Please Enter the second name")
With Sheets("ADANIENT")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIENT").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIENT").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIENT").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIENT").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
With Sheets("ADANIPORTS")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIPORTS").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIPORTS").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIPORTS").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ADANIPORTS").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
With Sheets("APOLLOTYRE")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
With Sheets("ARVIND")
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, x
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("ARVIND").Range("F" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("G" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & .Range("C" & Rows.Count).End(3).Row).AutoFilter 1, y
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("H" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.Range("B2:B" & .Range("C" & Rows.Count).End(3).Row).SpecialCells(12).Copy
Sheets("APOLLOTYRE").Range("I" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
End Sub
You can loop through the worksheets by walking through an array of their worksheet names or by the ordinal index number of their current position in the worksheet queue.
Sub watermasa_by_Name()
Dim x As String, y As String, lrc As Long, v As Long, vWSs As Variant
x = InputBox("Please Enter the first name")
y = InputBox("Please Enter the second name")
vWSs = Array("ADANIENT", "ADANIPORTS", "APOLLOTYRE", "ARVIND")
For v = LBound(vWSs) To UBound(vWSs)
With Sheets(vWSs(v))
lrc = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & lrc).AutoFilter 1, x
.Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("G" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & lrc).AutoFilter 1, y
.Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("I" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
Next v
End Sub
Sub watermasa_by_Index()
Dim x As String, y As String, lrc As Long, w As Long
x = InputBox("Please Enter the first name")
y = InputBox("Please Enter the second name")
For w = 4 To 31 ' maybe For w = 4 To sheets.count ?
With Sheets(w)
lrc = .Range("C" & Rows.Count).End(xlUp).Row
.Range("C1:C" & lrc).AutoFilter 1, x
.Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("F" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("G" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
.Range("C1:C" & lrc).AutoFilter 1, y
.Range("D2:D" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.Range("B2:B" & lrc).SpecialCells(xlCellTypeVisible).Copy
.Range("I" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
.AutoFilterMode = False
End With
Next w
End Sub
I'm not sure why you used the With ... End With statement for the copy and not the paste operation but it does clean up your code a bit.
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
I have the following code block to take out various errors and assign an error code description to the data. It works fine as long as the filter returns a result. If it does not then it deletes the header row. How can I prevent that from happening? Thanks in advance.
Sheets("Tempsheet").Select
Range("A1:K1").AutoFilter
Range("A1:K1").AutoFilter Field:=5, Criteria1:="0", Criteria2:=0
Range("K2:K" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "Excluded: $0.00 Amount"
Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
Sheets("Excluded").Select
Range("A2").PasteSpecial
Sheets("Tempsheet").Select
Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Delete
Sheets("Tempsheet").AutoFilterMode = False
If no data is returned by the filter then Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row) will return row 1, so test for row > 1 before doing the Delete
If Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).Row > 1 then
... .Delete
End If
Something like this code which tests for a filter result should do it
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = Sheets("Tempsheet")
Set ws2 = Sheets("Excluded")
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "k").End(xlUp))
rng1.AutoFilter Field:=5, Criteria1:="0", Criteria2:=0
If rng1.SpecialCells(xlVisible).Rows.Count > 1 Then
ws.Range("K2:K" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "Excluded: $0.00 Amount"
ws.Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
ws2.[a2].PasteSpecial Paste:=xlPasteValues
rng1.Offset(1, 0).Resize(rng1.SpecialCells(xlVisible).Rows.Count - 1).EntireRow.Delete
End If
Sheets("Tempsheet").AutoFilterMode = False
Sheets("Tempsheet").Select
Range("A1:K1").AutoFilter
Range("A1:K1").AutoFilter Field:=5, Criteria1:="0", Criteria2:=0
Range("K2:K" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "Excluded: $0.00 Amount"
Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
Sheets("Excluded").Select
Range("A2").PasteSpecial
Sheets("Tempsheet").Select
if Range("A" & Rows.Count).End(xlUp).Row > 1 then
Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Delete
end if
Sheets("Tempsheet").AutoFilterMode = False