I am trying to loop through all sheets and check them one by one and do the following: If in the checked cell the value of E18 = N/A then on the first sheet (named Summary) I'd change the value of G23 to N/A as well (and then do that for each cell, and on Summary change G23 then G24 then G25 and so forth) I wrote the following loop, it runs but it doesn't do anything whatsoever
Sub MyTestSub()
Dim ws As Worksheet
LastRow = Cells(Rows.Count, "G").End(xlUp).Row
For X = 22 To LastRow
For Each ws In Worksheets
If ws.Range("E18").Value="N/A" then ThisWorkbook.Sheets("Summary").Range("G"&x).Value="N/A"
Next ws
Next x
End Sub
Any help would be appreciated!
It needs to be a 2-Step procedure:
Check if IsError in the cell.
Check if the type of error is #N/A, with If .Range("E18").Value = CVErr(xlErrNA) Then.
Otherwise, if you have a regular String, like "Pass" you will get an error.
Code
Dim lRow As Long
LastRow = Sheets("Summary").Cells(Sheets("Summary").Rows.Count, "G").End(xlUp).Row
lRow = 23 ' start from row 23
For Each ws In Worksheets
With ws
If .Name <> "Summary" Then
If IsError(.Range("E18").Value) Then
If .Range("E18").Value = CVErr(xlErrNA) Then
Sheets("Summary").Range("G" & lRow).Value = CVErr(xlErrNA)
End If
End If
End If
End With
lRow = lRow + 1
Next ws
Try to reverse the nested loops. Something like this should be working:
Sub MyTestSub()
Dim ws As Worksheet
For Each ws In Worksheets
LastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
If IsError(ws.Range("E18")) then
For X = 22 To LastRow
Sheets("Summary").Range("G" & LastRow) = ws.Range("E18")
next x
end if
Next ws
End Sub
Furthermore, I assume that the LastRow is different per worksheet, thus you have to reset it quite often - every time there is a new worksheet.
Last but not least - make sure that you refer the worksheet, when you are refering to Cells, like this:
LastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
If you do not do it you will be taking into account the ActiveSheet.
Here is more about the errors in Excel and returning them - http://www.cpearson.com/excel/ReturningErrors.aspx
The solution will work with any error, not only with #N/A
Related
I'm very new to VBA. I have some code that will copy data that meets a certain criteria in one sheet to another master sheet. I have multiple other worksheets that I want to copy from into the master. How do I amend my code to do that please?
Thanks in advance.
Sub copyPaste()
Dim ws As Worksheet
Dim wt As Worksheet
Set ws = Sheets("S_Q")
Set wt = Sheets("master")
Dim i As Integer
Dim lr As Integer
lr = ws.Range("y" & Rows.Count).End(xlUp).Row
Dim lt As Long
For i = 1 To lr
lt = wt.Range("y" & Rows.Count).End(xlUp).Row
If ws.Range("bz" & i) > 14 Then
ws.Range("y" & i).EntireRow.Copy wt.Range("a" & lt + 1)
End If
Next i
End Sub
Without diving too far into the specifics of your code itself - will the criteria be the same for all worksheets you're wanting to run it on? And is the layout of the data in all of those worksheets?
If so, and if your current code is doing what you need it to do for Worksheet A and we just need to expand that to also handle Worksheets B through X, then you could get rid of your dim/set ws lines, and instead change your first line to
sub copyPaste(ws as worksheet)
This would allow you to then use a separate procedure to call this procedure for each of your worksheets that it needs to be run on. Below is an example using the worksheet from your original code:
call copyPaste(ThisWorkbook.Sheets("S_Q"))
I would put the sheets of interest to loop over in an array and loop that. I would also use Union to gather the qualifying ranges and paste in one go to be more efficient.
I would also use a helper function to retrieve the last row and add one to that to get next row.
Also, use Long rather than Integer to avoid potential overflow as there are more rows in a sheet than Integer can handle.
Option Explicit
Public Sub copyPaste()
Dim ws As Worksheet, wt As Worksheet, sheetsOfInterest(), unionRng As Range
Dim i As Long, lastRow As Long, lastRowMaster As Long
Application.ScreenUpdating = False
sheetsOfInterest = Array("Sheet1", "Sheet2", "S_Q")
Set wt = ThisWorkbook.Worksheets("master")
For Each ws In ThisWorkbook.Worksheets(sheetsOfInterest)
lastRow = GetLastRow(ws, 25)
For i = 1 To lastRow
If ws.Range("BZ" & i) > 14 Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, ws.Range("bz" & i))
Else
Set unionRng = ws.Range("BZ" & i)
End If
End If
Next i
If Not unionRng Is Nothing Then
With wt
unionRng.EntireRow.Copy .Range("A" & GetLastRow(wt, 1) + 1)
End With
End If
Set unionRng = Nothing
Next
Application.ScreenUpdating = True
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
End With
End Function
After trying the filter on various columns and it working on some and not others; with no apparent reasoning. I decided to rejig the spreadsheets and put the column to be filtered in the first column. This seems to be working so far.
Set ws4 = Workbooks("A.xlsx").Worksheets(1)
Lastrowto = ws4.Cells(Rows.Count, "B").End(xlUp).Row
For y = Lastrowto To 1 Step -1
If ws4.Cells(y, "B").Value = "Not found" Then
ws4.Rows(y).EntireRow.Copy
End If
Next y
The above piece of vba code copies only 1 (the first one) row but I want to copy all those rows for which the given condition is met, kindly suggest me the correct version of code.
Instead of using Copy>>Paste one row at a time, which will take a long time to process, you can use a Range object named CopyRng.
Every time the criteria is met (If .Range("B" & y).Value = "Not found"), it will add the current row to CopyRng.
After finishing looping through all your rows, you can just copy the entire rows at once using CopyRng.Copy.
Code
Option Explicit
Sub CopyMultipleRows()
Dim ws4 As Worksheet
Dim Lastrowto As Long, y As Long
Dim CopyRng As Range
Set ws4 = Workbooks("A.xlsx").Worksheets(1)
With ws4
Lastrowto = .Cells(.Rows.Count, "B").End(xlUp).Row
For y = Lastrowto To 1 Step -1
If .Range("B" & y).Value = "Not found" Then
If Not CopyRng Is Nothing Then
Set CopyRng = Application.Union(CopyRng, .Rows(y))
Else
Set CopyRng = .Rows(y)
End If
End If
Next y
End With
' copy the entire rows of the Merged Range at once
If Not CopyRng is Nothing Then CopyRng.Copy
End Sub
Where do you want to copy it to? if you specify a destination to your copy, then your code could work.
e.g. if you have a destination sheet defined as wsDest, you can replace
ws4.Rows(y).EntireRow.Copy
by
ws4.Rows(y).EntireRow.Copy wsDest.cells(rows.count,1).end(xlup).offset(1)
assuming you always have a value in column 1.
Another option is to do an autofilter on column B, with the value not found, and use the specialcells property to copy to another spot. Recording a macro will help you quite a bit, but code will be something like:
with ws4.cells(1,1).currentregion
.autofilter field:=2,criteria1:="Not found"
.specialcells(xlcelltypevisible).copy
end with
You are copying but there is no paste line.
An example, with a paste line destination of ws1.Cells(counter,"B"), assuming another worksheet variable ws1 might be:
ws4.Rows(y).EntireRow.Copy ws1.Cells(counter,"B")
See the following where a msgbox shows you each time you are entering loop and have met the condition so are copying:
Public Sub test1()
Dim ws4 As Worksheet
Dim lastrowto As Long
Dim y As Long
Dim counter As Long
Set ws4 = ThisWorkbook.Worksheets("Ben")
lastrowto = ws4.Cells(ws4.Rows.Count, "B").End(xlUp).Row 'fully qualify
counter = 0
For y = lastrowto To 1 Step -1
If ws4.Cells(y, "B").Value = "Not found" Then
ws4.Rows(y).EntireRow.Copy 'put paste destination code here e.g. ws1.Cells(counter,"B") where ws1 would be another sheet variable
counter = counter + 1
Msgbox counter 'if has entered loop print current count
End If
Next y
End Sub
I'm trying to create excel template (the volume of data will be different from case to case) and it looks like this:
In every even row is "Customer" and I would like to put in every odd row "Ledger". Basically it should put "Ledger" to every odd row until there are data in column C. I have this code:
'========================================================================
' INSERTING LEDGERS for every odd row (below Customer)
'========================================================================
Sub Ledgers()
Dim rng As Range
Dim r As Range
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
For i = 1 To rng.Rows.Count
Set r = rng.Cells(i, -2)
If i Mod 2 = 1 Then
r.Value = "Ledger"
End If
Next i
End Sub
But it gives me an error msg Invalid or unqualified reference. Could you advise me, where I have the error, please?
Many thanks!
If a command starts with . like .Cells it expects to be within a with statement like …
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
End With
So you need to specify the name of a worksheet where the cells are expected to be in.
Not that it would be a good idea to use Option Explicit at the top of your module to force that every variable is declared (you missed to declare i As Long).
Your code could be reduced to …
Option Explicit
Public Sub Ledgers()
Dim LastRow As Long
Dim i As Long
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
'make sure i starts with a odd number
'here we start at row 5 and loop to the last row
'step 2 makes it overstep the even numbers if you start with an odd i
'so there is no need to proof for even/odd
For i = 5 To LastRow Step 2
.Cells(i, "A") = "Ledger" 'In column A
'^ this references the worksheet of the with-statement because it starts with a `.`
Next i
End With
End Sub
Just loop with a step 2 to get every other row in your indexer variable.
Sub Ledgers()
Dim rng As Range
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Set rng = ActiveSheet.Range("C5:C" & LastRow)
For i = 1 To LastRow step 2
rng.Cells(i, 1) = "Ledger" 'In column A
Next i
End Sub
Data layout: A3 onwards to A(no specific last row) is referred to as under Name Manager as =PeriodPrev.
=PeriodPrev is a label that I have used to mark the data. =PeriodCurr label starts after the last populated row for PeriodPrev.
The remaining data for PeriodPrev and PeriodCurr lay under column E to W.
Code: How to I create a clear contents of data in Columns A and E to W for data belonging to =PeriodPrev in Column A?
I've tried the following code but it does not completely serves the purpose above. "If c.Value = "PeriodPrev" Then" returns error 13. "If c.Value = Range("PeriodPrev") Then" return error 1004.
Sub BYe()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim c As Range
Dim LastRow As Long
Dim ws As Worksheet
ws = ThisWorkbook.Worksheets("Sheet1")
LastRow = Range("A" & Rows.count).End(xlUp).Row
For Each c In Range("A3:A" & LastRow)
If c.Value = "PeriodPrev" Then
' If c.Value = Range("PeriodPrev") Then
c.EntireRow.ClearContents
End If
Next c
End Sub
Use Intersect
If Not Application.Intersect(c, Range(yourLabel)) Is Nothing Then
Let me know if it doesn't work
There were a few thing wrong with that code. I've tried to address some of the problems with comments
Sub BYe()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim c As Range, lastRow As Long, ws As Worksheet
'you need to SET a range or worksheet object
Set ws = ThisWorkbook.Worksheets("Sheet1")
'you've Set ws, might as well use it
With ws
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
For Each c In .Range("A3:A" & lastRow)
'the Intersect determines if c is within PeriodPrev
If Not Intersect(c, .Range("PeriodPrev")) Is Nothing Then
'this clears columns A and E:W on the same row as c.
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "E").Resize(1, 19)).ClearContents
End If
Next c
End With
End Sub
The following should perform the same action without the loop.
Sub BYe2()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim lastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lastRow = .Range("PeriodPrev").Rows(.Range("PeriodPrev").Rows.Count).Row
.Range("A3:A" & lastRow & ",E3:W" & lastRow).ClearContents
End With
End Sub
I there I have the following problem: I would like to paste the results in a new sheet if the outcome is not "NO MATCH", how can I paste this in the new sheet and after the last used row? I get an error on the Active.Paste
Here is my code:
Public Sub CopyRows()
Sheets("Koppeling data").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 4).End(xlUp).Row
' Loop through each row
For x = 3 To 10
' Decide if to copy based on column D
ThisValue = Cells(x, 4).Value
If ThisValue = "NO MATCH" Then
Else
Rows(x).Copy
Sheets("All sessions").Select
Call FindingLastRow
ActiveSheet.Paste
Sheets("Koppeling data").Select
End If
Next x
End Sub
Sub FindingLastRow()
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("All sessions")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
End Sub
Give this a shot. I simplified the code a lot, removed the .Select statements - which should be avoided at all costs- , and assigned variables to objects and worked directly with them.
Public Sub CopyRows()
Dim wsK As Worksheet, wsA As Worksheet
Set wsK = Sheets("Koppeling data")
Set wsA = Sheets("All sessions")
Dim FinalRow as Long
FinalRow = wsk.Cells(wsk.Rows.Count, 4).End(xlUp).Row
' Loop through each row in Koppeling data
For x = 3 To FinalRow
' Decide if to copy based on column D
If wsK.Cells(x, 4).Value <> "NO MATCH" Then
wsK.Rows(x).EntireRow.Copy _
Destination:=wsA.Range("A" & wsA.Rows.Count).End(xlUp).Offset(1) 'used `.Offset(1)` here so it will paste one row below last row with data.
'use this to paste values
'wsk.Rows(x).Copy
'wsA.Range("A" & wsA.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Next x
End Sub
You have FindingLastRow as sub, which doesn't do anything. If you want to return the result (in your case the last row), you have to define it as a function:
Function FindingLastRow() as Long
'Your existing code
FindingLastRow = LastRow
End Function
This will return the value of last row, and in the main sub you can just paste into the following row:
Dim lastRow as Long
lastRow = FindingLastRow
ActiveSheet.Range("A" & lastRow + 1).Paste
Try to get away from using Worksheet.Select and Range .Select to accomplish your actions.
Public Sub CopyRows()
Dim x As Long, lastRow As Long, finalRow As Long
With Worksheets("Koppeling data")
' Find the last row of data
finalRow = .Cells(.Rows.Count, 4).End(xlUp).Row
' Loop through each row
For x = 3 To 10 'For x = 3 To finalRow
' Decide if to copy based on column D
If UCase(.Cells(x, 4).Value) <> "NO MATCH" Then
FindingLastRow Worksheets("All sessions"), lastRow
.Rows(x).Copy Destination:=Worksheets("All sessions").Range("A" & lastRow + 1)
End If
Next x
End With
End Sub
Sub FindingLastRow(ws As Worksheet, ByRef lr As Long)
With ws
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
End Sub
The ByRef allows you to pass a previously declared variable into your helper sub and have that variable return with a changed value.
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.