I am trying to compare the values of two cells in two different workbooks (.csv files) that hold special characters (■, □)
The code is to compare the cell content with a reference cell and let the user know if they are the same.
e.g
CASE 1. □□□□□ (FOUND) to ■■■■■ (REFERENCE) --> Different value
CASE 2. ■■■■■ (FOUND) to ■■■■■ (REFERENCE) --> Same value
I have a FOR loop to run through the entries and an IF-statement to perform the comparison. The IF function is suppose check if the cells are equal
Unfortunately, my code keeps determining that the cells are not equal.
i.e CASE 2 keeps producing message feedback "Different Value"
I am unable to find the problem so any help would be appreciated.
Thank you!
[CODE BELOW]
Sub Value_Checker()
Old_Data = Application.GetOpenFilename _
(Title:="Please choose old data to import", _
FileFilter:="CSV Files *.csv (*.csv), ")
If Old_Data = False Then
MsgBox "No file specified.", vbExclamation, "Please pick old data"
Exit Sub
Else
Set OldFile = Workbooks.Open(Old_Data)
End If
Rowlim = 100
ThisWorkbook.Activate
CHECK = Cells(4, 3).Value
OldFile.Activate 'Activates old workbook
For i = 1 To Rowlim
ActiveSheet.Cells(i, 4).Select
If Cells(i, 4) <> CHECK Then
MsgBox "Different Value"
Else
MsgBox "Same Value"
End If
Next i
End Sub
I suggest you try strcomp():
StrComp(Cells(i, 4), CHECK, CompareMethod.Binary)
Some more information here.
Related
I have a simple program below that allows a user to input a vehicle with its hours and expenses for a specific date. The data is recorded on a sheet called "Data". I want to ensure that there is no repeated data entered for the same vehicle type for the same date as that would be redundant data. I was using the excel "find" function to achieve similar results in other places in my program but was having difficulty doing the same here as I now need to ensure that two columns in the same row have matching text. For reference, here is how I checked for matches in other parts of the code:
SDes = ""
a = 0
On Error GoTo continue
SDes = Sheets("Vehicles").Range("Dyn_Vehicles").Find(txtName)
Search = Me.txtName.Text
Set foundcell = Worksheets("Vehicles").Columns(1).Find(Search, LookAt:=xlWhole, LookIn:=xlValues)
'if exists - return record row
If Not foundcell Is Nothing Then RecordRow = foundcell.Row
If SDes <> "" Then
a = a + 1
Else
continue:
SDes = "0"
a = 0
End If
If a >= 1 Then
answer = MsgBox("Data already exists. Would you like to overwrite the previous entry?", vbCritical + vbYesNo, "Data Exists")
If answer = vbYes Then
Sheets("Vehicles").Range("Data_Start1").Offset(RecordRow - 1, 0) = expUF.txtName
Sheets("Vehicles").Range("Data_Start1").Offset(RecordRow - 1, 1) = expUF.txtRp
Sheets("Vehicles").Range("Data_Start1").Offset(RecordRow - 1, 2) = expUF.txtOC
MsgBox "Previous entry overwritten.", vbInformation, "Entry Overwritten"
Exit Sub
Else
MsgBox "New entry was not added.", vbInformation, "Entry Not Added"
Exit Sub
End If
End If
If a = 0 Then
MsgBox ("New vehicle added."), vbInformation, "Vehicle Added"
End If
Sheets("Vehicles").Range("Data_Start1").Offset(TargetRow, 0) = expUF.txtName
Sheets("Vehicles").Range("Data_Start1").Offset(TargetRow, 1) = expUF.txtRp
Sheets("Vehicles").Range("Data_Start1").Offset(TargetRow, 2) = expUF.txtOC
End If
userform
excel data
If you are just trying to remove duplicate data consider this. This will search the sheet, and range for any data that matches on the first two columns and remove duplicates. You can extend the array range if you want to encompass more than your Name and Date field as your "comparing" fields.
Sub test()
Worksheets("Vehicles").Range("Dyn_Vehicles").RemoveDuplicates Columns:=Array(1, 2)
End Sub
I'm making an ERP-system that stores all of my info in a spreadhseet, each row of data has its own ID number and I'm trying to write a code that pulls the entire row up when typing in the ID number for that specific row. Since the format for where it's going is not in a straight line I need to accsess each individual cell and copy it from that destination
I have already got the code for locating which row the data is on, now I trying to find a way to copy each cell I need from that row over to where I want it to go but I don't know how to use the row number any further.
InputValue = Application.InputBox("Type ID number", "Pull a delivery-note back up")
If InputValue = vbNullString Then
MsgBox "Please type an ID number to proceed"
Else
idRow = Sheets("Arkiv").Columns("A:A").Find(what:=InputValue).Row
'To output current row (temporarily there) *IGNORE*
MsgBox idRow
End If
Haven't found a way to further solve this
Something like this should work:
Sub Test()
Dim InputValue As Variant
Dim rID As Range
InputValue = Application.InputBox("Type ID number", "Pull a delivery-note back up")
If InputValue = vbNullString Then
MsgBox "Please type an ID number to proceed"
Else
With Sheets("Arkiv")
Set rID = .Columns("A:A").Find(what:=InputValue)
'Check the ID was found.
If Not rID Is Nothing Then
Union(.Cells(rID.Row, 1), .Cells(rID.Row, 2), .Cells(rID.Row, 5)).Copy _
Destination:=Sheets("Sheet1").Range("A1")
Else
MsgBox "ID not found."
End If
End With
End If
End Sub
Note - this will copy to cells A1:C1.
I have a large amount of data (approx 60 columns and 60,000 rows) formatted as a table in Excel. I'm looking to use a macro to replace all the values greater than 1 which reside in a column titled 'Salary' in the table with a value of '2'. the table is dynamic so I need to reference the replace to the Tables column name rather than a column range like D:D.
Update:
I have put together the following code but cannot get it to work when i use What:=">0" however it will work if what="5". What am I doing wrong?
Sub FindReplace3()
ActiveSheet.ListObjects("Table1").ListColumns(61).DataBodyRange.Replace _
What:=">0", replacement:="7", _
SearchOrder:=xlByColumns, MatchCase:=True
End Sub
Evaluate can be used to replace all at once :
[Table1[Salary]] = [if(Table1[Salary] > 1, 2, Table1[Salary])]
I see this is your first post on Stackoverflow, so, welcome.
I also see you have been marked down for your question which can be disheartening as a first introduction the the site.
On SO there is an expectation that you will have researched and tried a number of things first and posted that information with the question.
You are very close, but your code is failing because you are searching for a literal string ">0" (What:=">0"). >0 obviously does not exist as a literal string.
The built in replace function limits the find to a literal string. Therefore I would use this approach:
Sub replaceTest()
Dim dblCnt As Double
dblCnt = 0
With ThisWorkbook.Worksheets("Sheet1")
For i = 1 To Range("Table1").Rows.Count
If Range("Table1[Salary]")(i) > 1 Then
Range("Table1[Salary]")(i) = "2"
dblCnt = dblCnt + 1
End If
Next i
End With
MsgBox "Finished replacing " & CStr(dblCnt) & " items", vbOKOnly, "Complete"
End Sub
FYI, your code sample was referencing Column 61, but you said the column was called 'Salary'. You can reference the column name by changing your sample from:
ActiveSheet.ListObjects("Table1").ListColumns(61).DataBodyRange.Replace _
to
ActiveSheet.ListObjects("Table1").ListColumns("Salary").DataBodyRange.Replace _
I have added another code section below and credit must go to #Slai His approach using the 'Evaluate' function is instantaneous compared to my original answer:
Sub replaceTest001()
Dim StartTime As Date
StartTime = Now()
Dim dblCnt As Double
dblCnt = 0
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
[Table1[Salary]] = [if(Table1[Salary] > 1, 2, Table1[Salary])]
End With
Application.ScreenUpdating = True
MsgBox "Finished updating " & CStr(dblCnt) & " items" & vbCrLf & _
"Time taken: " & Format((Now() - StartTime), "hh:mm:ss"), vbOKOnly, "Complete"
End Sub
I need an Excel macro code that opens the user specified .csv file that exists in a shared drive and combines all the text into an array variable. This code is just a part of my case function.
Eg,
My csv file looks like this(It just has one column only)
line 1:apple|orange|grapes
line 2:potato|onion
Required output
searchTerms="apple|orange|grapes|potato|onion,..."
This was my attempt in writing the code:
Case Is = 4
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
lrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = 1 To lrow
counter = counter + 1
If counter = lrow Then Exit Sub
Cells(i, 1).Value
searchTerms = Trim(Cells(i, 1).Value) & "|" & " " & Cells(i + 1, 1).Value
Cells(i + 1, 1).EntireRow.Delete
i = i - 1
Next i
Using Application.Workbooks.Open (csvFileName) opened the required file as Jane suggested but still not able to figure out why its showing error at Cells(i,1).Value. So basically not able to combine all the data (in csv) into searchTerms still.
The MSDN topic for GetOpenFilename (https://msdn.microsoft.com/en-us/library/office/aa195744(v=office.11).aspx) describes what this function does:
"Displays the standard Open dialog box and gets a file name from the user without actually opening any files."
This means that after calling GetOpenFileName, your code will need to actually open the file:
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
Application.Workbooks.Open (csvFileName)
UPDATE:
The line Cells(i, 1).Value is giving an error because there isn't a valid statement or instruction for VBA to handle. You can use this statement to retrieve the value from a cell:
x = Cells(i, 1).Value
or to set the value in a cell:
Cells(i, 1).Value =x
but you're not doing either of those things. This line isn't doing anything useful and can be removed.
There are several other problems with the code. The following line finds out how many rows are in the sheet, then checks the row number of that row (eg if there are 3 rows, it asks for the row number of row 3):
lrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
You can just use:
lrow = ActiveSheet.UsedRange.Rows.Count
When you go through the loop, you take the value from the first cell, and add the pipe and the value from the current cell:
searchTerms = Trim(Cells(i, 1).Value) & "|" & " " & Cells(i + 1, 1).Value
However, this value is then thrown away when you get to the next cell, and you combine the value from the first cell with the pipe and the latest cell. This will work if there are only 2 rows, but for any more, you'll only end up with the values from the first and last cell. You could either store the updated searchTerms value in the first cell at each step in the loop, or you can just combine the values correctly as you go along.
Deleting the rows as you go along is probably causing the code to be more convoluted than it needs to be (eg needing to change the value of i within the loop and having a separate variable which exits the loop. I'd suggest avoiding that and just loop through the cells to create the searchTerms value. If you really need to delete the values, I'd do so afterwards. Here's how I've updated the code:
csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files (*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub
Application.Workbooks.Open (csvFileName)
lrow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lrow
If i = 1 Then
searchTerms = Trim(Cells(i, 1).Value)
Else
searchTerms = searchTerms & "|" & Trim(Cells(i, 1).Value)
End If
Next i
Debug.Print searchTerms
One additional point is that you've added a space after the pipe symbol when joining the strings. I've left that in, but it's not in your sample text, so you may need to remove it.
I'm trying to turn certain cells red based on information from a single row and column. What my algorithm is supposed to do is search through the single column and find a matching string and save that the column number, then do the same for the row. Then the script selects the cell and turns it red.
All the keys that I search for come from a piece of code that I found online and modified to suit my needs. It works perfectly. The problem is I can't get the search to work properly.
Option Explicit
Sub Blahbot()
Dim xRow As Long
Dim x As Long, y As Long
Dim xDirect$, xFname$, InitialFoldr$, xFF$
InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7) '<<< Where the search terms come from
Do While xFname$ <> ""
y = Application.WorksheetFunction.Match(Mid(xFname$, 11, 4), Range("D2:KD2"), 0) '<<< Find a matching string in table header
x = Application.WorksheetFunction.Match(Mid(xFname$, 16, 4), Range("B3:B141"), 0) '<<< Find matching string in column B
Cells(x, y).Select '<<<Select the cell and turn it red
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
xFname$ = Dir
Loop
End If
End With
End Sub
What the code does is that it reads through a folder, gets the file names, and splits them up. The name will always be ####_#### (where #=upper case letter and #### is a time in 24-hour format).
The Mid function splits that name up into the 4 letters and the time.
If you understand what I'm trying to do, could you suggest a better search algorithm or see what my code is doing wrong?
I simplified my answer because I may have misunderstood your question. MATCH returns a value relative to the range you look in. So if the match is in Column D, then MATCH returns 1. Therefore, you'll need to offset the returned value.
'Add 2 to x, since we start on 3rd row, add 3 to y since we start on 4th column
Cells(x+2, y+3).Select
You may also want to include code to check if there is no match. To see if you're having this issue, you can use the code below to test for this or add watches.
On Error Resume Next
y = Application.WorksheetFunction.Match(...)
If Err = 0 Then
MsgBox "All is well"
Else
MsgBox "There was an error with Match"
End If
On Error Goto 0