Copy Excel formula to last row on multiple work sheets - vba

I have a workbook which has multiple worksheets that vary in name but the content structure of each sheet remains the same. There is only one sheet name that is always constant pie.
I am trying to apply a formula in cell N2 and then copy the formula down to the last active row in all the worksheets except the one named pie
The code I have so far is works for one loop but then i get an error "AutoFill method of Range Class failed"
I have used
Lastrow = Range("M" & Rows.Count).End(xlUp).Row
to determine the last row as column M is always complete.
Any help to complete this would be very much appreciated
Code i have is:
Sub ConcatForm()
Dim wSht As Worksheet
Lastrow = Range("M" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each wSht In Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
wSht.Range("N2").AutoFill Destination:=Range("N2:N" & Lastrow)
End If
Next wSht
Application.ScreenUpdating = True
End Sub

You don't need to use Autofill to achieve this.
Just apply your formulas directly to your range and use relative references, i.e. K2, rather than absolute references, i.e. $K$2. It will fill down and update the formula for you.
Make sure you are fully qualifying your references. For example, see where I have used ThisWorkbook and the update to how lastrow is initialized. Otherwise, Excel can get confused and throw other errors.
Your lastrow variable hasn't been dimensioned so it is an implicit Variant. You'd be better off dimensioning it explicitly as a Long.
Sub ConcatForm()
Application.ScreenUpdating = False
Dim wSht As Worksheet
Dim lastrow As Long
With ThisWorkbook.Worksheets("Sheet1") 'which worksheet to get last row?
lastrow = .Range("M" & .Rows.Count).End(xlUp).Row
End With
For Each wSht In ThisWorkbook.Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2:N" & lastrow).Formula = "=CONCATENATE(K2,L2,M2)"
End If
Next wSht
Application.ScreenUpdating = True
End Sub

you were just one wSht reference away from the goal:
Sub ConcatForm()
Dim wSht As Worksheet
lastRow = Range("M" & Rows.count).End(xlUp).row '<--| without explicit worksheet qualification it will reference a range in the "active" sheet
Application.ScreenUpdating = False
For Each wSht In Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
wSht.Range("N2").AutoFill Destination:=wSht.Range("N2:N" & lastRow) '<--| this will reference a range in 'wSht' worksheet
End If
Next
Application.ScreenUpdating = True
End Sub

Use following sub...
Sub ConcatForm()
Dim wSht As Worksheet
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each wSht In Worksheets
With wSht
If .Name <> "Pie" Then
.Select
.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
.Range("N2").AutoFill Destination:=Range("N2:N" & Lastrow)
End If
End With
Next wSht
Application.ScreenUpdating = True
End Sub

Related

Copying the matched row in another sheet

I have two Sheets, sheet1 and sheet 2.
I am looking into column T of sheet1 and pasting the complete row if T contains 1 in sheet 2.
The code, works good, but it paste the result in sheet2 in the same row in sheet1.
This results in blanks, between the rows. Can anyone suggest, what i should Change with my code, so that i get them in sequence without any blank rows.
Also, how can I copy the Header in row 1 from sheet 1 to sheet2?
Sub Test()
For Each Cell In Sheets(1).Range("T:T")
If Cell.Value = "1" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets(1).Select
End If
Next
End Sub
There's no need to use Select and Selection to copy paste, it will only slows down your code's run-time.
Option Explicit
Sub Test()
Dim Cell As Range
Dim NextRow as Long
Application.ScreenUpdating = False
For Each Cell In Sheets(1).Range("T1:T" & Sheets(1).Cells(Sheets(1).Rows.Count, "T").End(xlUp).Row)
If Cell.Value = "1" Then
NextRow = Sheets(2).Cells(Sheets(2).Rows.Count, "T").End(xlUp).Row
Rows(Cell.Row).Copy Destination:=Sheets(2).Range("A" & NextRow + 1)
End If
Next
Application.ScreenUpdating = True
End Sub
Not For Points
Apologies, but I couldn't stop myself from posting an answer. It pains me when I see someone wanting to use an inferior way of doing something :(
I am not in favor of looping. It is very slow as compared to Autofilter.
If you STILL want to use looping then you can make it faster by not copying the rows in the loop but in the end in ONE GO...
Also if you do not like living dangerously then always fully qualify your object else you may end up copying the wrong row.
Option Explicit
Sub Sample()
Dim wsI As Worksheet, wsO As Worksheet
Dim lRow As Long, i As Long, r As Long
Dim copyRng As Range
Set wsI = Sheet1: Set wsO = Sheet2
wsO.Cells.Clear
'~~> first available row in sheet2
r = 2
With wsI
lRow = .Range("T" & .Rows.Count).End(xlUp).Row
'~~> Copy Headers
.Rows(1).Copy wsO.Rows(1)
For i = 1 To lRow
If .Range("T" & i).Value = 1 Then
If copyRng Is Nothing Then
Set copyRng = .Rows(i)
Else
Set copyRng = Union(copyRng, .Rows(i))
End If
End If
Next i
End With
If Not copyRng Is Nothing Then copyRng.Copy wsO.Rows(r)
End Sub
Screenshot

Copying dynamic rows from one worksheet to another in VBA

I am trying to copy a number of rows from each worksheet to the worksheet called "renew" in the same workbook.
The rows are defined as between the key words of "Service Requests" and "Renewals".
so step 1: define those row numbers, and step 2: copy them to the Renew sheet.
I run into the problem with step 2, somehow, i couldn't work out how to use the rownumber1 and rownumber2 in the copy command.
Any help would be appreciated. Thanks!
Sub test()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Renew").Activate
For Each ws In Worksheets
If ws.Name <> "Renew" Then
For i = 1 To 100
Dim rownumber1 As Integer
Dim rownumber2 As Integer
If Range("A" & i).Text = "Service Requests" Then
rownumber1 = i
ElseIf Range("A" & i).Text = "Renewals" Then
rownumber2 = i
End If
Next i
'copy rows between rownumber1 and rownumber2 to the renew sheet
ws.Rows("rownumber1:rownumber2").EntireRow.Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
End If
Next ws
End Sub
update:
Sub test2()
Dim ws As Worksheet
Dim rownumber1 As Integer
Dim rownumber2 As Integer
Dim FoundCell As Excel.Range
Application.ScreenUpdating = False
Sheets("Renew").Activate
For Each ws In Worksheets
If ws.Name <> "Renew" Then
Set FoundCell = ws.Range("A:A").Find(what:="Service Requests", lookat:=xlWhole)
If Not FoundCell Is Nothing Then
rownumber1 = FoundCell.Row
End If
Set FoundCell = ws.Range("A:A").Find(what:="Renewals", lookat:=xlWhole)
If Not FoundCell Is Nothing Then
rownumber2 = FoundCell.Row
End If
'copy renewals to the renewalsummary
ws.Rows(rownumber1 & ":" & rownumber2).EntireRow.Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
End If
Next ws
End Sub
What you're looking for is:
ws.Rows(rownumber1 & ":" & rownumber2).EntireRow.Copy
Although, there are some other things to consider with your code. It may be a work in progress so I only answered your question, but:
Your loop is going to return row 100 every time, so I'm curious what the point of your loop is.
You should never DIM in a loop, since you can only declare a variable once and the loop will attempt to do it every time and should throw an error (Dim your rownumber variables with your ws variable).
Why loop to 100? You should loop to the end of the list of values.
Reply to Edits
It looks pretty good. the main thing is that it works. Although I would change this:
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
to this:
ActiveSheet.Paste Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Hard-coded values aren't very future-proof, this looks at the last row of the sheet (whatever that might be). If any of your sheets start to reach the row max you need to do this:
If Cells(Rows.Count, 1) <> "" Then
ActiveSheet.Paste Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
MsgBox("Sheet " & ws.Name & " is full, row cannot be copied")
End If
But that's probably way down the road and at that point you might be outgrowing Excel.

VBA: looping through worksheets using nested For Each having worksheet as variable

Newbie at vba here. I'm trying to apply a simple For Each loop (which nullifies cells < 0) to all worksheets in the workbook by nesting this inside another For Each loop.
When I try and run my code below I get an error and I'm not sure if it has anything to do with having worksheet as a variable within a Set statement.
Can't seem to figure this out/find a solution.
Thanks
Sub deleteNegativeValue()
Application.DisplayAlerts = False
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In Workbooks(1).Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Next
End Sub
Try this:
Sub deleteNegativeValue()
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).row
If Not res Is Nothing Then
For Each cell In ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
There needs to be a check on the Find method, to ensure that something was found
you could try this
Option Explicit
Sub deleteNegativeValue()
Dim ws As Worksheet
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = Intersect(ws.Rows(1), ws.UsedRange).Find("value", LookAt:=xlPart)
If Not res Is Nothing Then
ws.Columns(res.Column).SpecialCells(xlCellTypeConstants, xlNumbers).Replace What:="-*", Replacement:="", SearchOrder:=xlByColumns, MatchCase:=False, LookAt:=xlWhole
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
which should run faster since it doesn't iterate through every cell of each column and restrict the Find method range to the used one instead of the entire row.
the only warning is that the first row of all searched in sheets must not be empty...
Try the second for-each this way:
ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))

Excel VBA Range object Error in Looping Through Worksheet

I am trying to loop through different sheets in my workbook. I have tried searching through stackoverflow but still stuck with the error. The error showed "Method 'Range' of object'_Worksheet' failed.
The purpose of this code is to standardise all formats in the worksheets.
Sub formatting()
Dim ws as Worksheet
Dim lastRow as long, lastColumn as long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastColumn = (Cells(1, Columns.Count).End(xlToLeft).Column)
For each ws in Activeworkbook.Worksheets
With ws.Range(cells(lastRow, 1), cells(1, lastColumn))
'rest of the actions I want to perform'
.font.bold = true
End With
Next ws
End Sub
I just got started on Excel vba, please enlighten me! Thank you!
Few changes to be made:
1. You have to redefine the last row and last column for each sheet. With that said, place the variable assignment inside the loop.
Instead of ws.Range(cells...), the proper syntax is Range(ws.cells...)
See below:
Sub formatting()
Dim ws As Worksheet
Dim lastrow As Long, lastcolumn As Long
For Each ws In ActiveWorkbook.Worksheets
lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastcolumn = (Cells(1, Columns.Count).End(xlToLeft).Column)
With Range(ws.Cells(1, 1), ws.Cells(lastrow, lastcolumn))
'rest of the actions I want to perform'
.Font.Bold = True
End With
Next ws
End Sub
You have to qualify the Cells calls as well as the Range call:
With ws.Range(ws.cells(lastRow, 1), ws.cells(1, lastColumn))
If you just got started in VBA I'd learn about setting ranges using .currentregion this will greatly help you in the future.
The code snippet makes all fields bold. If you are applying to all then currentregion can save code and possible errors on one condition "that all the fields are connected."
Sub formattingWithCurrentRegion()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1").CurrentRegion.Font.Bold = True
Next ws
End Sub
By setting the area as a range you can get greater control over ranges to set different formatting without having to deal with loops in loops.
See below
Sub formattingWithCurrentRegion()
Dim ws As Worksheet
Dim rSheet As Range
For Each ws In ActiveWorkbook.Worksheets
'' sets the CurrentRegion as a range. Use the immediate window rSheet.Select to see what CurrentRegion does.
Set rSheet = ws.Range("A1").CurrentRegion
'' now you can work with it
rSheet.Font.Bold = True
'' make the 2 column font.color to Red
rSheet.Resize(rSheet.Rows.Count, 1).Offset(0, 1).Font.Color = vbRed
''now clean up. Always set ranges to nothing when done with them.
Set rSheet = Nothing
Next ws
End Sub

Excel VBA copying rows using autofilter

Looking to copy rows from all sheets apart from my active sheet that meet a certain criteria in column J using VBA.
Not experienced in writing code in VBA so I have tried to frankenstein together the necessary parts from looking through other questions and answers;
below is the code I have written so far;
Sub CommandButton1_Click()
Dim lngLastRow As Long
Dim ws As Worksheet
Dim r As Long, c As Long
Dim wsRow As Long
Set Controlled = Sheets("Controlled") ' Set This to the Sheet name you want all Ok's going to
Worksheets("Controlled").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row
c = ActiveSheet.Cells(1, Columns.Count).End(x1ToLeft).Column
Range("J").AutoFilter
For Each ws In Worksheets
If ws.Name <> "Controlled" Then
ws.Activate
wsRow = ActiveSheet.Cells(Rows.Count, 2).End(x1up).Row + 1
Range("A" & r).AutoFilter Field:=10, Criteria1:="Y"
.Copy Controlled.Range("A3" & wsRow)
End If
Next ws
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Where Controlled is the sheet I want the data to appear in from the other sheets, and all other sheets are searched to see if their column J meets the criteria="Y"
I won't need to copy over formatting as all Sheets will have the formatting exactly the same and if possible I want the rows that are copied over to start at row 3
Try this:
Option Explicit
Sub ConsolidateY()
Dim ws As Worksheet, wsCtrl As Worksheet
Dim lrow As Long, rng As Range
Set wsCtrl = Thisworkbook.Sheets("Controlled")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
For Each ws In Thisworkbook.Worksheets
If ws.Name = "Controlled" Then GoTo nextsheet
With ws
lrow = .Range("J" & .Rows.Count).End(xlUp).Row
.AutoFilterMode = False
Set rng = .Range("J1:J" & lrow).Find(what:="Y", after:=.Range("J" & lrow))
If rng Is Nothing Then GoTo nextsheet
.Range("J1:J" & lrow).AutoFilter Field:=1, Criteria1:="Y"
.Range("J1:J" & lrow).Offset(1,0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
wsCtrl.Range("A" & wsCtrl.Rows.Count).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues
.AutoFilterMode = False
Application.CutCopyMode = False
End With
nextsheet:
Next
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
I think this covers everything or most of your requirement.
Not tested though so I leave it to you.
If you come across with problems, let me know.