Select Method of Worksheet Class Failed - vba

I have this sub in Excel 2010 which is supposed to filter through all the cells in a sheet until it finds a match to Proj No, then paste a field from this row into another field.
When I try to run the sub, it gives me an error 1004: Select Method of Worksheet Class Failed. I've marked the line where this occurs. Any assistance would be greatly appreciated.
Option Explicit
Private Sub btnNext_Click()
Dim ProjNo As String
Dim Col As String
Dim Row As String
Dim cell As Range
Unload Dialog
formWait.Show
Sheets("Sheet7").Activate
ProjNo = Worksheets("Sheet1").Range("D6").Value
Col = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A2:A" & Col) 
If cell.Value = ProjNo Then
Row = Row & cell.Row
End If
Next cell
Workbooks("Form.xlsm").Sheets("Sheet7").Range("Row, 6").Copy Destination:=Sheets("Sheet1").Range("19, 5") ‘Error
Unload formWait
End Sub

I don't know what GWP is, but I think you want to use ProjNo there. The Range property doesn't accept an argument like that. Unless you have a named range of "Row,6" which you don't because it's not a legal name, you have to supply Range with a valid range reference, like A6 or D2:D12, for example.
Also, you can't concatenate rows and use them in a Range reference to get a larger range. You would have to copy each row inside the loop, union the ranges as you go, or better yet, filter on the value that you want and copy the visible rows.
Try this:
Private Sub btnNext_Click()
With ThisWorkbook.Worksheets("Sheet7")
'filter for the project id
.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6).AutoFilter 1, "=" & .Range("D6").Value
'copy the visible rows
.Range("F2", .Cells(.Rows.Count, 6).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
ThisWorkbook.Worksheets("Sheet1").Cells(19, 5)
'get rid of the filter
.AutoFilterMode = False
End With
End Sub

There are a few confusing items in your code above, so I wanted to place them long-form here. Let's get started:
Dim Col As String
Dim Row As String
It looks like your design expects these to be of type Long rather than type String. Even if these variables were meant to be strings, I would recommend adjusting their names -- when your fellow developer attempts to review your design, he or she is likely to see names like "Col" or "Row" and think "these are numbers". Easy fix:
Dim Col As Long, Row As Long
The next issue comes up here:
Col = Cells(Rows.Count, "A").End(xlUp).Row
The structure above is a common method for identifying the last ROW, not column. (It also appears that you have switched the "A" and number, which is another easy fix). While it is perfectly acceptable syntactically to name the variable for last row "Col", human users are likely to find this confusing. Identifying the last row (and the last col, which you use in the For Each loop), as explained in fantastic detail here, would be better handled like this:
Dim SheetSeven As Worksheet, SheetOne As Worksheet
Dim LastRow As Long, LastCol As Long
Set SheetSeven = ThisWorkbook.Worksheets("Sheet7")
Set SheetOne = ThisWorkbook.Worksheets("Sheet1")
With SheetSeven
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
End With
This should make your For Each loop look like this:
With SheetSeven
For Each cell in .Range("A2:A" & LastCol)
'... do you comparison and row incrementing here
Next cell
End With
Once you've identified your sheet as a variable, the Range.Copy action should be much easier as well:
With SheetSeven
.Range(.Cells(Row, 6)).Copy _
Destination:=SheetOne.Range(SheetOne.Cells(19, 5))
End With

Also one other thing you may wish to check is the status of Application.ScreenUpdating.
With the release of Office 2013 and later, a SDI (Single Document Interface) was introduced. If Application.ScreenUpdating is False and the workbook is not active, the implied call to Workbook.Activate will fail. Check the status of ScreenUpdating and set it to True if needed. You can set it back to False after the first Activate call for that workbook is made.
See this article:
https://support.microsoft.com/en-us/help/3083825/excel-workbook-is-not-activated-when-you-run-a-macro-that-calls-the-wo

In my case the error came as the sheet was hidden.
so I check if I am not working with the hidden sheet. Or you need to unhide the sheet before you try to select or activate sheet.
For Each sh In ThisWorkbook.Sheets
If Left(sh.Name, 8) <> "Template" Then
sh.Select
sh.Range("A1").Select
End If
Next

Related

Select cells between bold cells using a loop

I am working with data where the only consistency is the layout and the bold headings to distinguish between a new date.
I am trying to find the cells in between these cells in bold, find the value "Individual" (in column A) in the selected rows, then sum the values of the given rows in column D (as there can be more then 1 row with "Individual"), and copy this new value to a different cell.
Since the cells between the bold is one date, if the value is not there, the output cell needs to shift down one without filling in anything.
Here is what I have so far:
Sub SelectBetween()
Dim findrow As Long, findrow2 As Long
findrow = range("A:A").Find("test1", range("A1")).Row
findrow2 = range("A:A").Find("test2", range("A" & findrow)).Row
range("A" & findrow + 1 & ":A" & findrow2 - 1).Select
Selection.Find("Individual").Activate
range("D" & (ActiveCell.Row)).Select
Selection.copy
sheets("Mix of Business").Select
range("C4").Select
ActiveSheet.Paste
Exit Sub
errhandler:
MsgBox "No Cells containing specified text found"
End Sub
How can I loop through the data and each time it loops through a range, no matter if it finds the value (e.g. individual) or not, shifts down one row on the output cell? Also, how can I change the findrow to be a format (Bold) rather then a value?
Here is some data for reference:
This is what I am trying to get it to look like:
So you have a good start to trying to work through your data. I have a few tips to share that can hopefully help get you closer. (And please come back and ask more questions as you work through it!)
First and foremost, try to avoid using Select or Activate in your code. When you look at a recorded macro, I know that's all you see. BUT that is a recording of your keystrokes and mouseclicks (selecting and activating). You can access the data in a cell or a range without it (see my example below).
In order to approach your data, your first issue is to figure out where your data set starts (which row) and where it ends. Generally, your data is between cells with BOLD data. The exception is the last data set, which just has a many blank rows (until the end of the column). So I've created a function that starts at a given row and checks each row below it to find either a BOLD cell or the end of the data.
Private Function EndRowOfDataSet(ByRef ws As Worksheet, _
ByVal startRow As Long, _
Optional maxRowsInDataSet As Long = 50) As Long
'--- checks each row below the starting row for either a BOLD cell
' or, if no BOLD cells are detected, returns the last row of data
Dim checkCell As Range
Set checkCell = ws.Cells(startRow, 1) 'assumes column "A"
Dim i As Long
For i = startRow To maxRowsInDataSet
If ws.Cells(startRow, 1).Font.Bold Then
EndRowOfDataSet = i - 1
Exit Function
End If
Next i
'--- if we make it here, we haven't found a BOLD cell, so
' find the last row of data
EndRowOfDataSet = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
End Function
To show you how to use that with your specific data, I've created a test subroutine indicating how to loop through all the different data sets:
Option Explicit
Public Sub DataBetween()
Dim thisWB As Workbook
Dim dataWS As Worksheet
Set thisWB = ThisWorkbook
Set dataWS = thisWB.Sheets("YourNameOfSheetWithData")
'--- find the first bold cell...
'Dim nextBoldCell As Range
'Set nextBoldCell = FindNextBoldInColumn(dataWS.Range("A1"))
'--- now note the start of the data and find the next bold cell
Dim startOfDataRow As Long
Dim endOfDataRow As Long
Dim lastRowOfAllData As Long
startOfDataRow = 3
lastRowOfAllData = dataWS.Cells(ws.Rows.Count, "A").End(xlUp).Row
'--- this loop is for all the data sets...
Loop
endOfDataRow = EndRowOfDataSet(dataWS, startOfDataRow)
'--- this loop is to work through one data set
For i = startOfDataRow To endOfDataRow
'--- work through each of the data rows and copy your
' data over to the other sheet here
Next i
startOfDataRow = endOfDataRow + 1
Do While endOfDataRow < lastRowOfAllData
End Sub
Use both of those together and see if that can get you closer to a full solution.
EDIT: I should have deleted that section of code. It was from an earlier concept I had that didn't completely work. I commented out those lines (for the sake of later clarity in reading the comments). Below, I'll include the function and why it didn't completely work for this situation.
So here's the function in question:
Public Function FindNextBoldInColumn(ByRef startCell As Range, _
Optional columnNumber As Long = 1) As Range
'--- beginning at the startCell row, this function check each
' lower row in the same column and stops when it encounters
' a BOLD font setting
Dim checkCell As Range
Set checkCell = startCell
Do While Not checkCell.Font.Bold
Set checkCell = checkCell.Offset(1, 0)
If checkCell.Row = checkCell.Parent.Rows.Count Then
'--- we've reached the end of the column, so
' return nothing
Set FindNextBoldInColumn = Nothing
Exit Function
End If
Loop
Set FindNextBoldInColumn = checkCell
End Function
Now, while this function works perfectly well, the situation is DOES NOT account for is the end of the last data set. In other words, a situation like this:
The function FindNextBoldInColumn will return nothing in this case and not the end of the data. So I (should have completely) deleted that function and replaced it with EndRowOfDataSet which does exactly what you need. Sorry about that.

First blank ("") cell in column with IF formula

I have a macro that exactly copies one sheet's data into another.
Sub QuickViewRegMgmt()
("Reg Management").Select
Cells.Select
Selection.Copy
Sheets("Quick View Reg Mgmt").Select
Cells.Select
ActiveSheet.Paste
End Sub
I would like for this macro to also go to the last non-blank cell in Column C (or first blank, I really don't care either way). I tried simple end/offset code, e.g.
Range("A1").End(xldown).Offset(1,0).Select
My problem, however, is that the direct copy macro also copies the underlying formulas, which for Column C is an IF formula. Therefore, no cell in the column is actually empty, but rather they all have an IF formula resulting in a true/false value (respectively, a "" or VLOOKUP).
=IF(VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE)=0,"",VLOOKUP('Reg Management'!$Y260,'Reg Guidance'!$A:$V,3,FALSE))
That means the end/offset code goes to the last cell in the column with the formula (C1000) instead of going to the first cell that has a value of "" (which is currently C260).
What code can I add to this macro to select the first cell that contains an IF formula resulting in a value of "" ---- which has the appearance of being blank?
After trying to be fancy with SpecialCells(), or using Find() or something I couldn't get it ...so here's a rather "dirty" way to do it:
Sub test()
Dim lastRow As Long, lastFormulaRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
For i = lastRow To 1 Step -1
If Cells(i, 1).Formula <> "" And Cells(i, 1).Value = "" Then
lastFormulaRow = i
Exit For
End If
Next i
End Sub
Edit2: Here's one using .SpecialCells(). Granted I think we can whittle this down more, I like it better:
Sub lastRow()
Dim tempLastRow As Long
tempLastRow = Range("C" & Rows.Count).End(xlUp).Row
Dim lastRow As Range
Set lastRow = Columns(3).SpecialCells(xlCellTypeFormulas).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, searchdirection:=xlPrevious, after:=Range("C" & tempLastRow))
Debug.Print lastRow.Row
End Sub
It returns 10 as the row.
Edit: Be sure to add the sheet references before Range() and Cells() to get the last row. Otherwise, it's going to look at your active sheet to get the info.

Type Mismatch 13 error when trying to activate a sheet

Everything I've read shows that I'm correctly denoting my variable and calling the sheet I want to activate. The last line is where I am getting the type mismatch. At that point CPIDws = CERN000006. I read somewhere that it might be problematic that the name is letters and numbers, but haven't found a way around it.
Sub Create_tab()
Dim newWS As Worksheet, CernWS As Worksheet, CPID As Variant
Dim Template As Worksheet, CPIDclm As Long, CERNdata As Range, CPIDcheck As Variant
Dim lngRow As Long, lngCol As Long, i As Integer, CPIDws As Worksheet
Set Template = Sheets("Template")
Set CernWS = Sheets("CERN ID's")
'Set lngRow = 1
'Set lngCol = 1
CernWS.Activate
Cells(1, 1).Select
Do
ActiveCell.Offset(1, 0).Select
Set CPID = ActiveCell
'create a new sheet as a copy of the template
Sheets("Template").Copy _
after:=ActiveWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'Name the new sheet as the current CPID value from CERN ID's worksheet
ActiveSheet.Name = CPID
Set CPIDws = ActiveSheet
'interigate AAA Data and update the new sheet with the data specific to the current cpid
Sheets("AAA Data").Activate
Cells(2, 3).Activate
Set CPIDcheck = ActiveCell
Do
If CPID = CPIDcheck Then
ActiveCell.Offset(0, -2).Select
Set CERNdata = Range(Selection, Selection.End(xlToRight))
End If
Sheets(CPIDws).Activate
At that point CPIDws = CERN000006.
No it doesn't. :)
You've declared CPIDws As Worksheet but you're using it as an argument to the Sheets method, which takes either an index (integer) or name (string) value.
Thus, type mismatch.
Try simply CPIDws.Activate
or, arguably you could do the redundant: Sheets(CPIDws.Name).Activate
THIS may also come in helpful, as it's generally recommended not to rely on Active (cell, sheet, etc.) or Selection when it can be avoided (which is almost always the case, except for some instance when you use the Selection as a method of input. But generally, your macro should probably never need to Select or Activate any cell other than that which the user had selected for input. In your case, since you're beginning at Cells(1,1) and controlling the iteration entirely through code, it's not at all necessary to Select or Activate anything.

Need to summarize data from multiple excel worksheets onto one summary page

I'm trying to create a yearly summary for some of our transfers. Essentially, I have 12 sheets, one for each month of the year, and each entry is given one of four specific "Transfer Rationales" in column L. I need to be able to create a worksheet that gives me a running year-to-date summary based on each transfer rationale.
So say, for example, the transfer rationale I'm looking at is called "Incorrectly Assigned" - I think need to have the summary page show columns G-K of each row where column L is "Incorrectly Assigned" from all twelve month sheets.
I've been looking at VBA code and trying to tweak some to work, but I could use some help!
EDIT:
Obviously it's not working as I need or I wouldn't be here, but I don't have much knowledge about VBA. I have something here where the code is grabbing the entries where column L met the criteria, but it was
a) copying all the columns, and I only need G-K to paste, and
b) was putting the copied rows all in one row in the summary tab, so I could see the data for a split second, and then it would overwrite with the next line and so on until it finally settled on the last entry found.
SECOND EDIT:
So I have a code that now (mostly) works, I've pasted it below and deleted the old code above.
Private Sub CommandButton1_Click()
Dim WkSht As Worksheet
Dim r As Integer
Dim i As Integer
i = 1
For Each WkSht In ThisWorkbook.Worksheets
i = i + 1
If WkSht.Name <> "Incorrectly Assigned" Then
For r = 1 To 1000
If WkSht.Range("L" & r).Value = Sheets("Incorrectly Assigned").Range("A1").Value Then
WkSht.Range("E:L").Rows(r & ":" & r).Copy
Sheets("Incorrectly Assigned").Range("E:L").End(xlUp).Offset(i, 0).PasteSpecial Paste:=xlPasteValues
End If
Next r
End If
Next WkSht
End Sub
The problem now is that it is only grabbing the last match from each worksheet - so say January has four matching entries, it's only pasting the fourth entry, then the next row down it'll paste the last entry from February etc. and then if there's an entry in say November that matches, it'll be pasted in the 11th row from the beginning, rather than each entry being pasted one after another.
Better to create a sub-routine that you call from your "CommandButton1". Then you can call the procedure from more than one location. You can also generalize it by using an input parameter 'transferID' which defines the summary you want.
Private Sub CommandButton1_Click()
Call PrintSummary("Incorrectly Assigned")
End Sub
It will likely need some tweaking to get it how you want, but this should give you some ideas to get you started:
Sub PrintSummary(transferID As String)
Dim ws As Excel.Worksheet
Dim wso As Excel.Worksheet
Dim lrow As Long
Dim rng As Excel.Range
Dim rngo As Excel.Range
Dim cell As Excel.Range
Dim colH As Variant
Dim i As Integer
'// Define columns for output
colH = Array("G", "H", "I", "J", "K")
'// Check for summary sheet (for output)
On Error Resume Next
Set wso = ThisWorkbook.Worksheets("Summary")
On Error GoTo 0
If wso Is Nothing Then
'// Summary worksheet does not exist :/
Exit Sub
Else '// format worksheet for output
'// for example...
wso.Cells.Delete Shift:=xlUp
Set rngo = wso.Range("A1") '// define output start
Set wso = Nothing
End If
'// Loop through worksheets
For Each ws In ThisWorkbook.Worksheets
'// Check for valid worksheet name
Select Case VBA.UCase(ws.Name)
Case "JAN", "FEB" '// and so forth...
Set rng = ws.Range("L1")
Set rng = ws.Range(rng, ws.Cells(Rows.Count, rng.Column).End(xlUp))
For Each cell In rng
If (VBA.UCase(cell.Text) = VBA.UCase(transferID)) Then
'// Print meta data
rngo.Offset(lrow, 0).Value = ws.Name
rngo.Offset(lrow, 1).Value = transferID
'// Print values
For i = 0 To UBound(colH)
rngo.Offset(lrow, i + 2).Value = ws.Cells(cell.Row, VBA.CStr(colH(i))).Value
Next i
'// Update counter
lrow = lrow + 1
End If
Next cell
Case Else
'// Not a month? do nothing
End Select
Next ws
End Sub
You do not need VBA - just refence the cell in the other tab:
SheetName!CellAddress
Precede the cell address with the worksheet name, and follow it with an exclamation point.
If you need VBA, then I have understood your question incorrectly.
EDIT:
Lets start with problem B:
was putting the copied rows all in one row in the summary tab
Lets look at the code you use to paste values:
Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Here you always paste everyting in the same place, in cell A65536 which you offset by one. On every iteration of your loop, the values will be at the same place. Change the Offset(1) to
Offset(0, r)
Now on every iteration you will paste on a different row, because r will be 1, 2, ..., 1000. See MSDN for documentation on Offset. Select a values that accomplished a paste the way you need.
Lets go to the next question:
a) it was copying all the columns
I will edit once the first part works as it should for you.

Copy multiple rows from one worksheet to another worksheet using macro/vba

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! :)