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?
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 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.
I have this code which is looking in a column (On a different sheet at XFD1) and creating an array from the values in that column. Then it is searching for those values one at a time across a row on the current sheet. When it finds a match, it cuts the column and inserts it at the location that corresponds to the order of the values in the array.
I'm not getting any compile errors. I placed a button (not ActiveX) on the worksheet and used it to execute the code. Here is what I see:
Nothing appears to happen. Columns are not moved at all.
The computer is obviously "thinking " because the whirly-gig is spinning away.
And here is the Mysterious part - The button disappears! it never comes back. I placed several buttons on the worksheet and tried them all. The button disappears every time.
I really need to get this working. All I want is to reorder the columns to the same order as my list on the other sheet (95 items in the list). I thought this code would do it but I seem to have entered the Twilight Zone and things are not as they seem (at least from my perspective)!
Here it is:
Sub Reorder_Columns()
Dim arrColumnOrder(1 To 95) As String
Dim index As Integer
Dim Found As range
Dim tick As Integer
For index = 1 To 95
arrColumnOrder(index) = UserFormDropDownDataSheet.range("XFD1")
Next index
Application.ScreenUpdating = False
tick = 1
For index = LBound(arrColumnOrder) To UBound(arrColumnOrder)
Set Found = Rows("1:1").Find(arrColumnOrder(index), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Found Is Nothing Then
If Found.column <> tick Then
Found.EntireColumn.Cut
Columns(tick).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
tick = tick + 1
End If
Next index
Application.ScreenUpdating = True
End Sub
The answer to the question concerning what was wrong with my original code is:
First, I was trying to set the size of the array but should have been working with a dynamic array as I expect the data in my array column will grow as I add more columns to the sheet I am trying to sort. So, Dim arrColumnOrder(1 To 95) As String should have been Dim arrColumnOrder As Variant.
I was then trying to iterate over my array with
For index = 1 To 95
arrColumnOrder(index) = UserFormDropDownDataSheet.range("XFD1")
Next index
Which of course is all wrong. I replaced this with
arrColumnOrder = UserFormDropDownDataSheet.range("XFD1:XFD95").Value
Then, in
Set Found = Rows("1:1").Find(arrColumnOrder(index), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
Should have been "... Find (arrColumnOrder(index, 1)..."
The answer to why the button was moving is that I did not Set the format option of the button (right click the button, Format Control>Properties>Select "Don't move or size with cells.") So when things were moving (and weirdly because my code was all wrong) The button moved with the cell when the column was copied and pasted.
Here is my final code and it works and does exactly what it is expected to do. Namely, it creates an array from the data in the range "XFD1:XFD95" (on a separate worksheet where I have the column headers stored in the proper order), then it sorts the columns in the active worksheet to match the order of the array. I did not want to explicitly call a sheet name as this will run on varying sheets. Using Find as opposed to Match, works just fine for me as this is not a huge amount of data I'm dealing with so speed is not an issue.
Sub Reorder_Columns()
Dim arrColumnOrder As Variant
Dim index As Interger
Dim Found As range
Dim tick As Integer
arrColumnOrder = UserFormDropDownDataSheet.range("XFD1:XFD95").Value
Application.ScreenUpdating = False
tick = 1
For index = LBound(arrColumnOrder) To UBound(arrColumnOrder)
Set Found = Rows("1:1").Find(arrColumnOrder(index, 1), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Found Is Nothing Then
If Found.column <> tick Then
Found.EntireColumn.Cut
Columns(tick).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
tick = tick + 1
End If
Next index
Application.ScreenUpdating = True
End Sub
For me, one of the big lessons here is to not try to write code when I have only slept for two hours! I was really tired and making silly mistakes because I was not thinking clearly. I got a good night's rest and then this morning I was easily able to see where I went wrong.
I'm a complete novice at macros but I've had trouble finding the exact solutions I need, and more trouble combining them. I get this raw data report which needs a couple of changes before I can input it into our master data set for reporting. These things need to happen (please refer to the picture):
The date needs to be expressed in the formation "mmm-yy". I've tried to add "01/" to make "01/04/2017" (I'm Australian so this is the 1st of April), but for some reason it automatically changes it to 04/01/2017. Ultimately, I need 04/2017 to go to Apr-17 for all data in the column
"Medical Div" change to "Medical" and "Mental Health Div" change to "Mental Health" - i've already sorted a macro for this, but not sure how to combine it with another macro for the other functions I'm wanting.
If anyone can help providing code or links to good resources which will allow me to perform all these functions at once with one macro that would be great.
Thanks
This can easily be done with Power Query instead of VBA. Power Query is a free add-in from Microsoft for Excel 2010 and 2013 and built into Excel 2016 as "Get and Transform". Conceptually, the steps are:
Load the data
insert a new column with a formula that combines the text "1/" with the column Month-Year
change the type of the new column to Date
remove the old Month-Year column
select the Division column
replace " Div" with nothing
Save the query
When new data gets added to the original data source, just refresh the query. All this can be achieved by clicking icons and buttons in the user interface. No coding required.
Well, for point 2, how about recording a macro and using Find and Replace twice?
This should combine them into a macro for you. Then you can copy paste that elsewhere.
As for the date, Excel has an predisposition to convert to US format. Try this first (assuming "Month-Year" column is B)
Range("B2") = DateValue(Range("B2"))
Then apply formatting later.
Private Sub mySub()
Dim myRng As Range
Dim r As Range
Dim LastRow As Long
Dim mySheet As Worksheet
Dim myFind1, myFind2 As Variant
Dim myReplace1, myReplace2 As Variant
'This will get the number of rows with value in the sheet
LastRow = Sheets("Sheet1").UsedRange.Rows.Count
'This is for the first find and replace. It will search all cells with exact value of "Medical Div" in the sheet and change it to "Medical".
myFind1 = "Medical Div"
myReplace1 = "Medical"
'This is for the second find and replace. It will search all cells with exact value of "Mental Health Div" in the sheet and change it to "Mental Health".
myFind2 = "Mental Health Div"
myReplace2 = "Mental Health"
'This will loop through the entire column with the date that needs to have the format mmm-yy. It will convert the 04/2017 to date format first before making it Apr-17.
With Sheets("Sheet1")
Set myRng = Sheets("Sheet1").Range("A2:A" & LastRow)
For Each r In myRng
r.Value = CDate(r.Value)
Next r
End With
myRng.NumberFormat = "mmm-yy"
'This will loop through the active worksheet and apply the find and replace declared above.
For Each mySheet In ActiveWorkbook.Worksheets
mySheet.Cells.Replace what:=myFind1, Replacement:=myReplace1, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
mySheet.Cells.Replace what:=myFind2, Replacement:=myReplace2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next mySheet
End Sub
Here is a code that you could try.
It will change the date format of the column with Month-Year to
"Apr-17" regardless of the current date format.
It will also find and replace the Medical Div and Mental Health Div
to "Medical" and "Mental Health".
You will need to change the range to suit your needs. I have set the column for the month-year to column A. You must change it to column B if that is where your dates are.
This is my data before running the macro:
Here is my data after running the macro:
Summary: I am writing a macro that takes names from many different sheets in an excel file and compiles them together on a "master list", but I'm having trouble with referencing a cell on another sheet.
The Problem: When I refer to a specific cell using the sheet name as reference with Sheets("MasterList").ActiveCell.Offset(0, 1), nothing gets picked up. However, when I remove Sheets("MasterList") the macro works fine (the macro is currently on "MasterList" at the time which is the only way this would work). Also, the spelling for the name of the sheet was correct in my code.
Question: Why is this happening? The logic behind the code seems sound, and I'm spelling my sheet name correctly.
Code:
Do
If Sheets("MasterList").ActiveCell.Offset(0, 1) = firstName Then 'IF FIRST AND LAST NAMES MATCH, EXIT THE CHECK
Exit Do
End If
On Error Resume Next
Cells.Find(What:=lastName, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Loop Until Err.Number > 0
ActiveCell is a property of the Application object, not a Sheet.
There is only one ActiveCell, and it is the active cell on the currently active sheet.
It's not entirely clear what you are trying to do. But in general you should avoid Select and Activate with this sort of code. Use instead somthing like:
Dim wsMasterList as Worksheet
Set wsMasterList = Thisworkbook.WorkSheets("MasterList") ' assuming the vba code is in the workbook containing MasterList
To track the last used cell in MasterList use a variable like
Dim rMasterList as Range
Set rMasterList = wsMasterList.Cells( ... ' Specify the cell you want
Then use rMasterList.Offset(0, 1) to refer to cells relative to that cell
Searching on MasterList use:
Dim cl as Range
Set cl = wsMasterList.UsedRange.Find( ... )
If Not cl Is Nothing Then
' cl will be Nothing if the search term is not found
' ...