I am new to VBA and am trying to recode a program that already exists, with the intention of optimizing it and adding new features. The program takes a scanner input (though I am just manually entering in the numbers at the moment), which then records and categorizes the type of item that is taken out. It is then put in a log for reference later. Here is the first Userform that takes the scanned input:
Private Sub TextBox1_Change()
Dim barcode As Long, emptyRow As Long, testHold As Long
Set TempHold = Worksheets("TempHold")
If Application.WorksheetFunction.CountIf(TempHold.Range("D2:D25"), TextBox1.Value) = 1 Then
If Application.WorksheetFunction.CountIf(Range("B:B"), TextBox1.Value) = 0 Then
CartTypeMenu.Show
barcode = TextBox1.Value
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 1).Value = Application.WorksheetFunction.VLookup(barcode, TempHold.Range("D2:E25"), 2, True)
Cells(emptyRow, 2).Value = barcode
Cells(emptyRow, 3).Value = Format(Now(), "mm/dd/yyyy hh:nn")
Cells(emptyRow, 4).Value = CartTypeMenu.ComboBox1.Value
TextBox1.Value = ""
Else
testHold = TextBox1.Value
Call boxTest(testHold)
End If
End If
End Sub
I have two tables in a separate sheet (TempHold) that have the scanned input corresponding to a number, and a number corresponding to a name. The row in the final log would basically be the number of the scanned input (as they are labeled by number), the scanned input, the time (which works properly), the type and then the name.
The problem I run into is when I search VLookup for the name to put into the next cell in the log row; getting the name from a number. It only looks for the name if it is actively in the log (it is cleared once tasks are completed). I have tried changing the numbers to strings, and vice versa, but I can't get it to work. Here is the problematic module:
Sub boxTest(testHold As Long)
Dim offsetValue As Long, myValue As Variant
Set ws = Worksheets("Log")
Set sheetLookup = Worksheets("TempHold")
offsetValue = Application.Match(testHold, ws.Range("B2:B8"), 0)
myValue = InputBox("Enter your number")
ws.Range("E" & offsetValue).Value = Application.WorksheetFunction.VLookup(myValue, sheetLookup.Range("A2:B9"), 1, True)
End Sub
VLookup keeps giving the error that it can't find the WorksheetFunction in this module.
Related
I have a User Form that searches a table column and returns all the values in the row as editable fields on the form. It works fantastic! But I wanted to add another column to the search. I would like to use the last 4 numbers of an 11 digit number so I created another column with a formula that returns the last 4 digits.
I set the variable with:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0).
and it works fine. The column is filled with 6 digit numbers populated by this reference: =IFERROR(JobSheetData[#[W/O]],"").
However, when I change it to this:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
it will not find the row with the search value.
I have a column in the table that uses this reference =IFERROR(JobSheetData[#[ON1Call Ticket '#]],"") and then I have the column Ticket Search that contains the last 4 digits as mentioned above.
The W/O column that is searchable has every line filled with data but 40% of the Ticket Search column is blank. I tried removing values from the W/O column to see if that was the issue but it still worked.
Here is all the code:
Private Sub CommandButton1_Click()
Dim RecordRow As Long
Dim RecordRange As Range
Dim sChkBoxResult As String
' Turn off default error handling so Excel does not display
' an error if the record number is not found
On Error Resume Next
'Find the row in the table that the record is in
**This one works:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0)
**This one doesn't:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
' Set RecordRange to the first cell in the found record
Set RecordRange = Range("JobSheet").Cells(1, 1).Offset(RecordRow - 1, 0)
' If an erro has occured i.e the record number was not found
If Err.Number <> 0 Then
ErrorLabel.Visible = True
On Error GoTo 0
Exit Sub
End If
' Turn default error handling back on (Let Excel handle errors from now on)
On Error GoTo 0
' If the code gets to here the record number was found
' Hide the error message 'Not Found'
ErrorLabel.Visible = False
' and populate the form fields with the record's data
TextBoxNameAddress.Value = RecordRange(1, 1).Offset(0, 3).Value & " - " & RecordRange(1, 1).Offset(0, 2).Value & " " & RecordRange(1, 1).Value
TextBoxHold.Value = RecordRange(1, 1).Offset(0, 5).Value
TextBoxDays.Value = RecordRange(1, 1).Offset(0, 7).Value
CheckBoxLocate.Value = RecordRange(1, 1).Offset(0, 9).Value
TextBoxCount.Value = RecordRange(1, 1).Offset(0, 11).Value
TextBoxFirst.Value = RecordRange(1, 1).Offset(0, 13).Value
TextBoxOveride.Value = RecordRange(1, 1).Offset(0, 14).Value
CheckBoxBell.Value = RecordRange(1, 1).Offset(0, 15).Value
CheckBoxGas.Value = RecordRange(1, 1).Offset(0, 16).Value
CheckBoxHydro.Value = RecordRange(1, 1).Offset(0, 17).Value
CheckBoxWater.Value = RecordRange(1, 1).Offset(0, 18).Value
CheckBoxCable.Value = RecordRange(1, 1).Offset(0, 19).Value
CheckBoxOther1.Value = RecordRange(1, 1).Offset(0, 20).Value
CheckBoxOther2.Value = RecordRange(1, 1).Offset(0, 21).Value
CheckBoxOther3.Value = RecordRange(1, 1).Offset(0, 22).Value
End Sub
UPDATE:
Here is a screenshot of some sample data:
The data starts in column A
My ultimate goal was to have an if statement that would run either the 6 digit search on the W/O column or the 4 digit search on the ON1Call Ticket # column based on the length of the string in TextBoxSearch Since they are either 4 digit or 6 digit, I thought I would base it on if the value was >9999 but the `ON1Call Ticket #' column is a text column and not numeric and the search fails.
When the first utility locate arrives the 10 or 11 digit ticket number is automatically added to the Job Sheet. As the emails arrive from the various utilities, the ticket number is always used for identification. I have an automation that extracts the Ticket number and saves the incoming locates as PDF files using the ticket number and some random characters characters as the file name. I have it set up to split the filename like this: 123456 7890 - jkes.pdf. A person now renames the file to indicate what utilities are included in that file and and uses the middle set of 4 numbers in the User Form:
to find the correct record and check the checkbox of the corresponding utility. I don't want the user to have to type all 11 digits and I was trying to avoid a helper column but I could not figure out how to make the 4 digit search look only at the last 4 digits of the ticket number.
At other times we need to search by the Work Order # which is 6 digits.
I would maybe do something like this:
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch As Long, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = CLng(TextBoxSearch.Value)
For Each col In Array("W/O", "Ticket Search") 'loop over columns to search in
'no need for On Error Resume Next - test the return value from Match instead
RecordRow = Application.Match(vSearch, lo.ListColumns(col).DataBodyRange, 0)
If Not IsError(RecordRow) Then Exit For 'got a hit - stop searching
Next col
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
EDIT: after clarification - different search methods depending on length of input
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = TextBoxSearch.Value
If Not IsNumeric(vSearch) Then
MsgBox "Search value must be numeric!"
End If
'decide how to search based on length of search input
Select Case Len(vSearch)
Case 4
'call custom function instead of Match
RecordRow = EndsWithMatch(vSearch, lo.ListColumns("ON1Call Ticket #").DataBodyRange)
Case 6
'cast search value to Long before using Match
RecordRow = Application.Match(CLng(vSearch), lo.ListColumns("W/O").DataBodyRange, 0)
Case Else
MsgBox "Search value must either 4 or 6 digits!"
End Select
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
'search a single-column range of data for an "ends with" match to `vSearch`
Function EndsWithMatch(vSearch, rngSrch As Range)
Dim i As Long, arr
arr = rngSrch.Value
For i = 1 To UBound(arr, 1)
If arr(i, 1) Like "*" & vSearch Then
EndsWithMatch = i
Exit Function 'done searching
End If
Next i
EndsWithMatch = CVErr(xlErrNA) 'no match: return error value as in Match()
End Function
Common to both answers (edit - added some suggestions for saving the edited record):
Dim editedRow as Range 'holds a reference to the row loaded for editing
'Better as a stand-alone method which you can call from other places...
Sub LoadRecord(sourceRow As Range)
With sourceRow
TextBoxNameAddress.Value = .Cells(4).Value & " - " & _
.Cells(3).Value & " - " & .Cells(1).Value
TextBoxHold.Value = .Cells(6).Value
'etc for other fields
End With
Set editedRow = sourceRow 'set a global for the row being edited
'also enable the "Save" button...
End Sub
Sub SaveRecord()
If Not editedRow Is Nothing Then
With editedRow
.Cells(6).Value = TextBoxHold.Value
'etc for the other fields
End With
Else
MsgBox "No row is being edited!"
End If
End Sub
It's easier/safer to test the return value from Match() than to turn off errors.
I am trying to export data from excelsheet to excel Invoice template.
The VBA code which I have, It considers each row as a different Invoice and hence makes a different workbook for each row.
So in case I have 1 invoice which has 3 products this code considers each of the product (row) as separate Invoice which is not correct.
I want to modify it in a way that if the Invoice number (PiNo) is repeated in the next row then it means the next product (row) belongs to the above Invoice only.
I am new to VBA hence I have taken code from another site.
Here is the code:-
Private Sub CommandButton1_Click()
Dim customername As String
Dim customeraddress As String
Dim invoicenumber As Long
Dim r As Long
Dim mydate As String
Dim path As String
Dim myfilename As String
lastrow = Sheets(“CustomerDetails”).Range(“H” & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
ClientName = Sheets("CustomerDetails").Cells(r, 6).Value
Address = Sheets("CustomerDetails").Cells(r, 13).Value
PiNo = Sheets("CustomerDetails").Cells(r, 5).Value
Qty = Sheets("CustomerDetails").Cells(r, 9).Value
Description = Sheets("CustomerDetails").Cells(r, 12).Value
UnitPrice = Sheets("CustomerDetails").Cells(r, 10).Value
Salesperson = Sheets("CustomerDetails").Cells(r, 1).Value
PoNo = Sheets("CustomerDetails").Cells(r, 3).Value
PiDate = Sheets("CustomerDetails").Cells(r, 4).Value
Paymentterms = Sheets("CustomerDetails").Cells(r, 7).Value
PartNo = Sheets("CustomerDetails").Cells(r, 8).Value
Shipdate = Sheets("CustomerDetails").Cells(r, 14).Value
Dispatchthrough = Sheets("CustomerDetails").Cells(r, 15).Value
Modeofpayment = Sheets("CustomerDetails").Cells(r, 16).Value
VAT = Sheets("CustomerDetails").Cells(r, 17).Value
Workbooks.Open ("C:\Users\admin\Desktop\InvoiceTemplate.xlsx")
ActiveWorkbook.Sheets("InvoiceTemplate").Activate
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Z8”).Value = PiDate
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AG8”).Value = PiNo
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AN8”).Value = PoNo
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B16”).Value = ClientName
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B17”).Value = Address
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B21”).Value = Shipdate
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“K21”).Value = Paymentterms
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“T21”).Value = Salesperson
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AC21”).Value = Dispatchthrough
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL21”).Value = Modeofpayment
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B25”).Value = PartNo
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“J25”).Value = Description
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Y25”).Value = Qty
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AF25”).Value = UnitPrice
ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL39”).Value = VAT
path = "C:\Users\admin\Desktop\Invoices\"
ActiveWorkbook.SaveAs Filename:=path & PiNo & “.xlsx”
myfilename = ActiveWorkbook.FullName
ActiveWorkbook.Close SaveChanges:=True
Next r
End Sub
"H" is the Product column and the data starts from Row 2. Row 1 are headers.
enter image description here
enter image description here
enter image description here
There are a few areas to address when it comes to what you want to achieve vs. your current code. I'll outline this below in no particular order and provide some sample code to help you achieve what you want.
Your code to create, save and close the new workbook is contained within your for loop. This means that if we assume you have 3 products to add to your invoice, your code is going to open the InvoiceTemplate.xlsx from the desktop a total of 3 times and also save it and close it with the PiNo name 3 times. To fix this you should move the code to open the workbook before your For loop starts and move the SaveAs code to after the loop so it's only saving and closing the workbook once.
Your code uses .activate and makes reference almost entirely to the ActiveWorkbook (if you don't declare the workbook it will assume ActiveWorkbook). This should be avoided and you should be explicitly defining the object you are using instead (why you should do this has already been discussed at great length - you can read more about it here: How To Avoid Using Select in Excel.
You have declared a few variables that you don't actually use. Either use them or remove them to declutter the code.
You haven't declared the variables storing the values from your sheet (at the start of your for loop) which means they are automatically created as the data type Variant which is not very efficient.
The for loop writes the variables to set cell references which means even if we fix all other issues, the code will just overwrite the same cells with each loop iteration. This can be resolved by setting the row value into a variable and increment it with each loop iteration (assuming this is how the template should be completed).
As a side point; using longer but more descriptive variable names can make life a lot easier when debugging errors, especially when you're new to VBA so you may want to consider this with all of your variables. E.g. LoopRow OR RowCounterForLoop instead of r and InvoiceTemplatePath OR SavedInvoicesPath instead of path.
Here is an example code to give you an idea how to implement some changes taking the above points into account, in it we will use the PiNo variable only (but just copy the changes to each of the other relevant variables):
Private Sub CommandButton1_Click()
Dim LastRow As Long
Dim RowCounterForLoop As Long
Dim InvoiceTemplateRowCounter as Long
Dim DesktopFilePath As String
Dim SavedInvoiceFilePath As String
Dim PiNo As String
LastRow = ThisWorkbook.Sheets("CustomerDetails").Range("H" & Rows.Count).End(xlUp).Row
InvoiceTemplateRowCounter = 8
DesktopFilePath = "C:\Users\admin\Desktop\"
SavedInvoiceFilePath = "C:\Users\admin\Desktop\Invoices\"
Workbooks.Open (DesktopFilePath & "InvoiceTemplate.xlsx")
For RowCounterForLoop = 2 To lastrow 'I've removed the previous assignment of 2 to RowCounterForLoop as it is assigned on this line.
PiNo = ThisWorkbook.Sheets("CustomerDetails").Cells(r, 5).Value 'I've added ThisWorkbook before the Sheet which explicitly defines the code to affect the workbook the code is running on. It also uses a variable instead of number to allow dynamic referencing to the range.
Workbooks("InvoiceTemplate.xlsx").Sheets("InvoiceTemplate").Range("AG" & InvoiceTemplateRowCounter).Value = PiNo 'I've added Workbooks("InvoiceTemplate.xlsx") to explicitly run this code on that workbook which avoids using ActiveWorkbook.
InvoiceTemplateRowCounter = InvoiceTemplateRowCounter + 1
Next RowCounterForLoop
Workbooks("InvoiceTemplate.xlsx").SaveAs Filename:=SavedInvoiceFilePath & PiNo & ".xlsx"
Workbooks("InvoiceTemplate.xlsx").Close SaveChanges:=False 'The file is saved on the previous line so this will avoid saving again and pop up prompts etc.
End Sub
The above won't fix everything and there are better and more efficient ways to achieve what you want but it does provide an answer to your question.
You may want to consider the following to further improve your code:
Using Arrays to store data and then write it to the new workbook. (This may be rather tricky depending on your skills using Arrays with VBA)
To enter the PiNo into each row (when there are more than 1 product) you can use the Range.FillDown method (depending on how exactly your sheet works) which you can read about Here.
I have a excel spreadsheet where I have values in a form format, I need to convert them into tabular format. example -
Project ID/Name: 3001 Miscellaneous Improvements
Location: This is Project Location.
Description: This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description.
Justification: This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification.
Duration: Q1 2013 to Ongoing
Status: This is some status
Each block starts with Project ID/Name, however, Description and Justification can vary according to the size of text they have. All the headings are in Column A. If I use Find for ProjectID - and use offset at a fixed length it works but if Justification and description are bigger or smaller they don't fall in correct place. Please help.
You can use TextToColumns. Example:
'Split this cells when find ':" or <TABS>
[A1:A6].TextToColumns Destination:=[A1], DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, OtherChar:=":", _
FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
From what I understand, you want to convert a vertical "form" into a table of data. I suggest adding that data to an existing table.
Here's the code.
You'll need to edit some variables (sheet/range names)
Public Sub test()
'insert your code to get each Worksheet and it's column range here
transferFormDataToTable Range("Sheet1!B1:B100"), Worksheets(2).ListObjects(1)
End Sub
Public Sub transferFormDataToTable(yourRangeB As Range, dbTable As ListObject)
' make a reference to the form data range
Dim formRange As Range
Set formRange = yourRangeB
'create a new ListRow in your target table
Dim listR As ListRow
Set listR = dbTable.ListRows.Add
'transfer the data from form to the new ListRow
Dim lastHeader As String
lastHeader = ""
Dim targetColumnOffset As Integer
targetColumnOffset = 0
Dim currentColumn As Integer
currentColumn = 0
Dim i As Integer
For i = 1 To formRange.Count
'if the row's header is not empty and different than previous row
'then we'll know we have a new column of different type of data
If lastHeader <> formRange(i).Offset(0, -1).Value And formRange(i).Offset(0, -1).Value <> "" Then
lastHeader = formRange(i).Offset(0, -1).Value
targetColumnOffset = 0
currentColumn = currentColumn + 1
End If
'this loop captures data that might have been placed in columns to the right of the input cell
Dim rowString As String
rowString = ""
Dim j As Integer
j = 0
Do While True
If formRange(i).Offset(0, j).Value <> "" Then
If rowString = "" And targetColumnOffset = 0 Then
rowString = formRange(i).Offset(0, j).Value
Else
rowString = rowString & "; " & formRange(i).Offset(0, j).Value
End If
j = j + 1
Else
Exit Do
End If
Loop
If targetColumnOffset = 0 Then
listR.Range(currentColumn).Value = rowString
Else
listR.Range(currentColumn).Value = listR.Range(currentColumn).Value & rowString
End If
targetColumnOffset = targetColumnOffset + 1
'Exit the loop if it seems to get the end
If formRange(i).Value = "" And formRange(i).Offset(0, -1).Value = "" Then _
Exit For
Next i
End Sub
Notes:
Excel has weird bugs occasionally when creating editing with VBA empty tables that have only 1 or 2 rows. I suggest using this macro only when your table has 3+ rows.
Send me a note if you want a much more complete version of this. Namely, a problem you might eventually have with this short version is that the code will screw up if a user switches columns around.
EDIT
I just adapted the code to your requirements. This is bound to get buggy eventually though. I'd really look into convincing the team about just how much they need to find a more appropriate tool. Good luck.
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
I'm relatively new to VBA and I'm trying to write a macro that will compare two columns of data (first and last names). While traversing the column, any time first name = last name (ie. they're both blank or say UNKNOWN) I want the cell in the 9th column to be cleared and the cell in the 10th column to get the value UNKNOWN.
As of now, the code correctly recognizes any time when the first and last name are identical. My problem is that any time first name is a sub-string of any last name (ie. cell I2=David J2=Jones , I3=Joseph J3=Davidson) David gets compared with Davidson and is subsequently erased.
I've spent a while looking for similar problems and I haven't been able to adapt anything to my problem thus far. Thanks in advance for any help.
Sub compare_cols()
Dim Report As Worksheet
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set Report = Excel.ActiveSheet
lastRow = Report.UsedRange.Rows.count
Application.ScreenUpdating = False
For i = 1 To lastRow ' This will find all identical pairs of cells in I,J (blank, blank) or (unknown, unknown). I stays blank, J gets UNKNOWN
For j = 1 To lastRow ' I think its currently erasing any matches (ex. if someones first name is James, it will get erased if there is a last name jameson)
If InStr(1, Report.Cells(j, 10).Value, Report.Cells(i, 9).Value, vbTextCompare) > 0 Then
Report.Cells(i, 9).Value = ""
Report.Cells(i, 10).Value = "UNKNOWN"
Exit For
Else
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Unlike some other languages, you can compare strings in vba just using the "=" sign and that will find exact matches, which is what it appears you are looking for. Try
if Report.Cells(j, 10) = Report.Cells(i, 9) etc.