I'm new to VBA and have been playing around with the basics.
What I'm tasked to do is to extract data from a certain row based on the header and column's data. Example, if column under the header "ENG JOBSCOPE" <> "", then extract row of that data.
However, i'm stuck at a point where when the macro loops thru all the worksheets, if the criteria that i want to find using range.find could not find, it'll give me error 91.
I've read up about using normalise but i can't seem to make it work.
Currently i'm using this code
J = 1
For Each ws In x.Worksheets
For Each wks In y.Worksheets
With x.Worksheets(ws.Name)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i=2 to Lastrow
EJOB = Range("A1:DE1").Find(What:="ENG JOBSCOPE", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Column
'Error 91 comes from the above line ^^^
EJobs = ws.Cells(i, EJOB).Value
If EJobs <> "" then
x.Sheets("ID").Rows(i).Copy
y.Sheets("ID").Range("A" & j).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
J=J+1
End if
Next i
Next wks
Next ws
End sub
"ENG JOBSCOPE" is a header. However, some of the worksheet consist of "ENG JOB SCOPE".
Is there another method where i can use to make it so that it'll find the column number regardless of space or capitalization in between?
Also, some of the worksheet doesn't consist of the "ENG JOBSCOPE". Is there a way for the code to continue searching without it stopping with error 91?
I've tried using on error goto next, but the data gets jumbled up.
I hope what i typed is sufficient enough or clear enough. If it isn't clear enough please tell me what is needed to type as i'm new to this forum.
Thank you very much in advance!
use wildcard.
EJOB = Range("A1:DE1").Find(What:="ENG*JOB*SCOPE", LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Column
If you want Find to work regardless of capitalisation, type MatchCase:=False.
Related
What I want:
I've got a lot of sheets whith different devices. Let's call one of these sheets "WS1".
And I've got a seperate sheet with all existing devices and the appropriate OS next to it. This one we call "list".
Now I want the other sheets (e.g. the "WS1") to check the "list", find the right device, and copy the right OS into the WS1-sheet.
the manual way would be:
select cell "C3" of WS1 and copy it.
open the "list"-Sheet and find the copied entry
select the cell left to the found entry and copy it
open the WS1 again, select the left cell right next to the active cell and paste the new clipboard (which contains the OS)
select the next cell which is under and on the right side of the active cell.
loop until every device in WS1 is filled with an OS
What I've got so far:
Dim DataObj As New MSForms.DataObject
Dim strCliBoa As String
'strCliBoa = DataObj.GetText
DataObj.GetFromClipboard
Range("C3").Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("list").Select
Range("A1").Select
Cells.Find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Selection.Copy
strCliBoa = DataObj.GetText
Sheets("WS1").Select
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 1).Select
My issue:
"Runtime Error 91: Object variable or with block variable not set"
and it marks the cells.find-method.
Can someone tell me what I'm doing wrong?^^
Thanks in advance!
(oh, almost forgot: I'm using ms excel 2010 on Win7)
If the string you're looking for isn't found you'll get that error. The find function returns "Nothing" if nothing is found
Dim r As Range
Set r = Cells.find(What:=strCliBoa, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
If r Is Nothing Then
'handle error
Else
'fill in your code
End If
I'll provide you an answer using the VLOOKUP() function. So Sheet1 contains several devices and I need to find the correct OS. Sheet2 contains the matching between device and OS.
On Sheet1 enter this formula in the cell next to device and pull it down (of course edit to your specific needs).
=VLOOKUP(A2;Sheet2!$A$1:$B$20;2;0)
EDIT: the VLOOKUP function will only work if the OS is in second column. Either switch around the columns or use a helper column at the end to contain the OS.
In the sheet where you have the Device name (WS1) put formula:
=INDEX(List!$A$2:$B$10;MATCH('WS1'!C3;List!$B$2:$B$10;0);1)
Where :
List!$A$2:$B$10 is a range where you have the Devices + OS in the list
'WS1'!C3 is the Device you want to search for in the list ("WS1" in your case)
List!$B$2:$B$10 is the column on Sheet List, where the devices are listed.
Edit 1 - VBA code
If you want to use VBA then use this :
Sub FindDevicePasteOS()
'Find corresponding OS for the device
Dim intRow As Integer
Dim wsht As Worksheet
For Each wsht In Worksheets
If wsht.Name <> "List" Then 'add more sheets you want to exclude using OR (e.g. ... Or wsht.Name <> "Cover Sheet" Then)
For intRow = 3 To wsht.Cells(Rows.Count, 3).End(xlUp).Row 'presuming there is nothing else in the column C below the devices
If Not Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)) Is Nothing Then
wsht.Cells(intRow, 2) = Worksheets("List").Cells.Find(what:=wsht.Cells(intRow, 3)).Offset(0, -1)
End If
Next intRow
End If
Next wsht
End Sub
So I used a psuedo solution where I added the If x is nothing block to the code to skip over the err'd pieces. I was able to process about 80% of the data which is good for me. I still can't understand why Find would return nothing.
Another interesting and maybe related problem occurred in a different computer running the same macro - after I ran into this problem a few times, my computer gave me a blue screen with a 'thread stuck in driver' message. Could they be related? Excel processing to much to fast and get's mixed in the thread processing?
Food for though, I dunno why the find won't just work every-time.
In Sobigen post I had to switch the part LookAt:=xlPart to LookAt:=xlWhole to get it to work because If r Is Nothing Then was throwing an error when it found partial matches. Other than that the code worked great thanks!
I'm having problems, Excel is not updating rows referring to other sheets in same workbook when ordering rows alphabetically.
I have a userform in which there's a button insertCM with this code:
Private Sub insertButton_Click()
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xltoDown
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
nomCM = Empty
CXinitial = Empty
resteCX = Empty
CCselect = Empty
C4initial = Empty
resteC4 = Empty
compteurCT = Empty
Range("A8").Activate
ActiveCell.RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i).Select
emptyRow = Range("A9").End(xlDown).Offset(0, 2).Row
Range("A9:AL" & emptyRow).Sort _
Key1:=Range("A9"), Order1:=xlAscending
Set SearchRange = Range("A8", Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheet2.Select
End
End Sub
The userform is used for inserting new clients in several sheets at the same time. Textbox inserts Name, Cost Center, etc., in a blank row and insertButton inserts a new row leaving data inserted in row 8 to go to row 9. After that the code puts all rows alphabetical order so the new client now in row 9 goes to the new one, and cells containing formulas change row numbers.
However some of the sheets have cells containing references to other sheets' cells in the same row. So imagine:
I insert client name "LORUM" "Cost Center 4" and it puts him in row 9 so formula is:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
...but when it changes his row to the final one, formula row is:
=$C18-COUNTIF($E18:$P18;"CT")+'Sheet5'!$D9
It does not change row when referring to other sheets.
Any ideas?
It's looks like you've made a good effort, but there are still numerous problems with your code (beside the one line), and I can guarantee that a combination of these issues are preventing your intended outcome.
I can't fix it completely because there are so many bugs that I'm not clear on what you're trying to do, but hopefully this will get you started on the right track...
xlToDown is not a valid reference. You probably mean xlDown
you have a number of undeclared variables and objects, like: i, emptyRow, SearchRange, FindRow, nomCM
you have things (objects?) "set to nothing" that aren't declared or used anywhere: CXinitial, resteCX, CCselect, C4initial, resteC4, compteurCT
your Find statement is looking for nomCM which is empty (and never set), so the Find statement will never find anything.
You should put Option Explicit at the top of every module (especially when learning or troubleshooting). This will prevent issues like the ones above by "forcing" you to properly declare & handle all of your variables, objects, properties, etc.
Near the end, you refer to Sheet2.Select as if Sheet2 is a declared object, instead of using Sheets("Sheet2").Select. I'm not sure why you're selecting the sheet at the very end anyhow.
You have an With..End statement that is doing absolutely nothing since you don't reference it with a . dot anywhere: With Sheets(i).Select .. End With, and also Select isn't used like that.
A mystery End near the end for some reason.
Also, you're unnecessarily doubling up commands like:
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown
..instead of:
ActiveCell.EntireRow.Insert Shift:=xlDown
and another example, all this:
Range("A9:AK9").Copy
Range("A8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Selection.PasteSpecial Paste:=xlPasteFormats
Range("C10").Copy
Range("C8:C9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy
Range("H8:AK8").Select
Selection.PasteSpecial Paste:=xlPasteAll
...instead of:
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
All of this would be more clear by Googling the documentation for each command you're unfamiliar with, such as:
Range.Copy Method (Excel)
Range.PasteSpecial Method (Excel)
XlPasteType Enumeration (Excel)
All the ActiveCell and ThisWorkbook references are troublesome but again, I'm not sure what to do with them since I don't know your workbook.
Indentation (and general organization) are very important as well. It may not change the way that the code runs, but it will help you (and others) track down existing & potential issues more easily.
Here is your code cleaned up as best as I could:
Option Explicit 'this line goes at the very top of the module
Private Sub insertButton_Click()
Dim i As Long, emptyRow As Long, SearchRange As Range, FindRow As Range, nomCM
nomCM = Empty
ActiveCell.EntireRow.Insert Shift:=xlDown
Range("A9:AK9").Copy
Range("A8:AK8").PasteSpecial xlPasteValuesAndNumberFormats
Range("C10").Copy
Range("C8:C9").PasteSpecial Paste:=xlPasteFormulas
Range("H9:AK9").Copy Range("H8:AK8")
Range("A8").RowHeight = 18.6
For i = 2 To ThisWorkbook.Sheets.Count
With Sheets(i)
emptyRow = .Range("A9").End(xlDown).Offset(0, 2).Row
.Range("A9:AL" & emptyRow).Sort Key1:=.Range("A9"), Order1:=xlAscending
Set SearchRange = .Range("A8", .Range("A200").End(xlUp))
Set FindRow = SearchRange.Find(nomCM, LookIn:=xlValues, LookAt:=xlWhole)
.Range("A" & FindRow.Row).Select
ActiveCell.EntireRow.Activate
End With
Next i
Sheets("Sheet2").Select
End Sub
as per my test, sorting actually doesn't change other sheet direct references
so you may want to use OFFSET to keep referencing the actual current row index
instead of:
=$C9-COUNTIF($E9:$P9;"CT")+'Sheet5'!$D9
use
=$C9-COUNTIF($E9:$P9;"CT")+ OFFSET('Sheet5'!$D1,ROW()-1,0)
I found a solution:
=INDIRECT(ADDRESS(ROW();4;3;1;"Sheet5"))
Where Row() will always refer to the actual cell's row.
Hope it will help you!
I am having issues with the below code, which is trying to filter a set of data, then delete the visible rows. Currently I get a "Run Time 1004 Error: Delete Method or Range Class Failed" which occurs on the last line of my code. I found a similar question on the site, and the answer appears to be exactly what I have in my last line of code.
Dim LastRow As Long
LastRow = Worksheets("Orders").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Orders").Range("A1:CU" & LastRow).AutoFilter Field:=10, Criteria1:="New"
If Worksheets("Orders").Range("A1:CU" & LastRow).SpecialCells(xlCellTypeVisible).Count > 1 Then
Worksheets("Orders").Range("A1:CU" & LastRow).Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
Later in my code, I filter the same set of data again, this time deleting the non-visible (filtered out) rows. I am also getting the same error on the last line of this code as well:
Worksheets("Orders").Range("$A1:CC" & LastRow).AutoFilter Field:=26, Criteria1:= _
"=*Jazz*", Operator:=xlAnd
Dim oRow As Range, rng As Range
Dim myRows As Range
With Sheets("Orders")
Set myRows = Intersect(.Range("A:A").EntireRow, .UsedRange)
If myRows Is Nothing Then Exit Sub
End With
For Each oRow In myRows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rng Is Nothing Then
Set rng = oRow
Else
Set rng = Union(rng, oRow)
End If
End If
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
Any help on these errors would be much appreciated!
You dont need to invoke the SpecialCells before deleting, because the method Delete acts only on the visible rows. The problem might be due to this.
Besides, the test .SpecialCells(xlCellTypeVisible).Count > 1 is useless because the header row of the filtered range remains visible.
Here's a safer and simpler way to write your code:
With Worksheets("Orders").UsedRange
.AutoFilter 10, "New"
.Offset(1).EntireRow.Delete ' <--- no need for .SpecialCells
End With
Post by #A.S.H is a great illustration of minimalism, but your 1st code block is still fine.
Just to make a small correction, change .SpecialCells(xlCellTypeVisible).Count > 1 to .SpecialCells(xlCellTypeVisible).Count > 2 as pointed out by him. Also, don't forget to add the line Worksheets("Orders").ShowAllData at the end.
The 2nd code block is unnecessarily complicated (and hence likely error-prone). Instead, simply change the filter of the 1st code block to Criteria1:="<>New" if you want to eliminate other than "New" items.
The Run Time Error issue seems to be due to something else. Make sure the sheet is not protected.
To see if it's the code or the file format that's causing the problem, you can also test the same code on a new workbook copying just the data (paste value) from your existing one and then run the code.
You should remove any filters at the top of your code.
On Error Resume Next
If Worksheets("Orders").AutoFilter.FilterMode = True Then
Worksheets("Orders").ShowAllData
End If
The below section of code works majority of the time but occasionally it will throw an error for
loc.PasteSpecial xlValues
with
Runtime 1004' PasteSpecial Method of class failed
I cant get it to regularly fault either so is hampering me tracking down the cause. Error doesn't happen when stepping through the code.
This method of copy and paste special is used a few times through out the macro.
Other answers for this question seem to be different use cases so I'm struggling to find the issue within my code.
'extracts the cfc data out to its own table if its there.
If Not IsError(Application.Match("CFC", rng1, 0)) Then
wb2.Sheets("Import").Activate
'reset filter to show all data
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
If ActiveSheet.AutoFilterMode = False Then ActiveSheet.Range("A1:BK1").AutoFilter
ActiveSheet.Range("A1:BK1").AutoFilter Field:=1,
'filters data based on criteria
Criteria1:=Array("*criteria1*"), Operator:=xlFilterValues
ActiveSheet.Range("A1:BK1").AutoFilter Field:=5, Criteria1:=Array("*CFC*"), Operator:=xlFilterValues
'Copys the rows that are visable.
Range("A2:BK" & ActiveSheet.UsedRange.Rows.Count + 1) _
.Cells.SpecialCells(xlCellTypeVisible).Rows.Copy
wb2.Sheets("CFC").Select
'reset filter to show all data
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
With Range("a:a") 'find the next available row on sheet data using column A
Set loc = .Find(What:="", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
End With
outputrow = loc.Row 'sets the output row
loc.PasteSpecial xlValues
loc.PasteSpecial xlFormats
End If
Basic fuction is.
Autofilter data based on Criteria on the main data sheet
Copy remaining viable rows
Reset filtering on destination sheet
Find empty row at bottom of table
Paste copied rows to the found location.
I've been trying to sort this for a while now so any help would greatly appreciated.
Only copy the range immediately before you paste it (use a variable to store the range to copy). – Rory
As Rory commented. It was not placing the copy immediately before the paste that was causing the issues.
The copy code was changed to use a sheet reference variable and placed right before the paste and now the macro works as intended 100% of the time. :)
outputrow = loc.Row 'sets the output row
sh1.Range("A2:BK" & sh1.UsedRange.Rows.Count + 1) _
.Cells.SpecialCells(xlCellTypeVisible).Rows.Copy
loc.PasteSpecial xlValues
loc.PasteSpecial xlFormats
I have a very limited knowledge of VBA. However, with the help of google I did the script which searches for the column called Email. Then if it finds it it looks if in this column are any commas. If yes, then it changes commas into dots.
However, this solution is case sensitive. If the column name is slightly different, then it doesn't work. So far I know there are 2 different options which were used in the files which this script will clean
1. Email
2. Email - Personal Email
I would like to be able to make this script to work in all Email starting columns. I tried to specify this as "Email*" but it didn't work. Can someone help me?
Sub mySample()
Sheets("Data").Activate
Dim cell As Excel.Range
Dim ws As Excel.Worksheet
Dim i As Integer
Dim j As Integer
For Each ws In Excel.ThisWorkbook.Sheets
i = ws.Cells(1, Excel.Columns.Count).End(Excel.xlToLeft).Column
For j = 1 To i
If ws.Cells(1, j).Value = "Email" Then
Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Next j
Next ws
Sheets("Automation").Activate
MsgBox "Removing commas in emails - Done!"
End Sub
I'd recommend you to use different approach: instead of looping trough cells of 1st column - just use Excel Search to identify the e-mail column:
LookupString = "Email"
Set SearchRange = ActiveWorkbook.ActiveSheet.Range("1:1").Find(LookupString, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
With the options given you'll find properly ANY LookupString value match, regardless of position and case in column name. Replace ActiveWorkbook.ActiveSheet. part with the names of WB / sheet as required.
Further you may use returned SearchRange properties, such as Column, for further processing of data in the column. Good luck!
Use InStr function:
If InStr(UCase(ws.Cells(1, j).Value), UCase("Email")) Then
UCase function converts a string to all upper-case, so your comparison is not case sensitive anymore
As far as making If ws.Cells(1, j).Value = "Email" more inclusive, I'd suggest using InStr instead. This will search for the string "email" anywhere in the cell, and let you know the position at which it appears. If it's anything other than 0, that means the string was found. (More on InStr here.)
For j = 1 To i
If Instr(1,ws.Cells(1, j).Value,"email",vbTextCompare) > 0 Then
Cells.Replace...
The Cells.Replace... line looks little weird to me as well. Is that working properly for you?