We have an SQL database that exports to excel. Each record in the database is the evaluation of a project. Each project has a project identifier (string). Since a project can be evaluated two times, each project can have two records. The difference between the two records is the id number (number), with the most recent record having a higher id number. The records are exported to excel with each record as a row in the spread sheet. I am trying to write a sub that compares the two project identifiers and deletes the row with the lower id number. I keep getting an object required error for SameP.
Dim Pident1 As String
Dim Pident2 As String
Dim IdNumb1 As Variant
Dim IdNumb2 As Variant
Dim i As Integer
Dim SameP As Integer
i = 2
For i = 2 To 100
Pident1 = ActiveSheet.Cells(i, 2).Text
Pident2 = ActiveSheet.Cells(i + 1, 2).Text
IdNumb1 = ActiveSheet.Cells(i, 1).Value
IdNumb2 = ActiveSheet.Cells(i + 1, 1).Value
Set SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
If SameP = 0 And IdNumb1> Idnumb2 Then Data.Rows(i).EntireRow.Delete
Next i
End Sub
Any help would be greatly appreciated. I'm not a programmer, i just try when I can. Thanks in advance.
You need to change this
SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
to this:
SameP = StrComp(Pident1, Pident2)
The error is this line also
Data.Rows(i).EntireRow.Delete
Change this to
Sheets("Name_of_sheet_here").Rows(i).EntireRow.Delete
Alternatively this would work too
Activeworksheet.Rows(i).EntireRow.Delete
Change this:
Set SameP = StrComp(Pident1, Pident2, CompareMethod.Text)
If SameP = 0 And IdNumb1> Idnumb2 Then Data.Rows(i).EntireRow.Delete
to
SameP = StrComp(Pident1, Pident2, vbTextCompare )
If SameP = 0 And IdNumb1> Idnumb2 Then ActiveSheet.Rows(i).EntireRow.Delete
Related
I am trying to run an excel vba form to search through the lines, but for some unknown reason I get the error:
Method Range of object Global failed
Private Sub CommandButton3_Click()
Dim last, i As Integer
Dim ref, lote As String
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
last = Range("analisegeral").End(xlUp).Row + 1
For i = 2 To last ref = Cells(i, 8)
lote = Cells(i, 13)
If TextBox1.Text = ref Then
TextBox2.Text = lote
GoTo fim
End If
Next i
If TextBox1.Text <> ref Then
TextBox2.Text = ""
MsgBox "Referência não encontrada!", vbInformation
TextBox1.Text = ""
TextBox2.Text = ""
GoTo fim
End If
fim:
End Sub
There are few issues with your code.
Invalid declaration
Dim last, i As Integer
Dim ref, lote As String
Note that last and ref are declared as Variant type here, unless it was your intent, change it to following:
Dim last As Integer, i As Integer
Dim ref As String, lote As String
Failing to activate worksheet where range is located
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
The fact that your sheet is hidden (or very hidden) disallows it's selection.
Probably this is the case of your error.
Wrong method of calculating last row number
last = Range("analisegeral").End(xlUp).Row + 1
Given you will actualy select analisegeral sheet, this still doesn't make sense:
Range("NamedRange") is a construction that allows to refer to previously named range (either with VBA or manualy). Unless you have one, this will raise another error. Perhaps you meant something like this?
last = Range("A" & Rows.Count).End(xlUp).Row
This will give you a number of column A last row.
Final advice: avoid using Select
I have data that it's not in a consistent position in the cell, sometimes it has a semicolon, sometimes it is to the right or the left of the semicolon. The end result I'm looking is to have in column B all "students" (defined by not being teacher) and in Column C, all Teachers. If no student or teacher is found, then the corresponding cell should be blank.
Currently I'm doing a text to columns to separate both columns then using the following formulas to have the student and teacher separate:
=IF(SUMPRODUCT(--ISNUMBER(SEARCH({"Arts and Music","Math and Science"},A2)))>0,B2,C2)
=IF(SUMPRODUCT(--ISNUMBER(SEARCH("Teacher",A2)))>0,B2,C2)
I still have to do a manual Find and replace to remove the parenthesis and text and leave only the student/teacher name.
IS there any VBA macro that can help me to get from Column A to my expected result in columns B and C? Thank you.
You can use regular expressions to do this. See this post on how to enable them in excel.
Sub FindStrAndCopy()
Dim regEx As New RegExp
regEx.Pattern = "\s*(\w+)\s*\((.+)\)"
With Sheets(1):
Dim arr() As String
Dim val As String
Dim i As Integer, j As Integer
Dim person As String, teachOrSubject As String
Dim mat As Object
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row:
val = Cells(i, "A").Value
arr = Split(val, ";")
For j = 0 To UBound(arr):
Set mat = regEx.Execute(arr(j))
If mat.Count = 1 Then
person = mat(0).SubMatches(0)
teachOrSubject = mat(0).SubMatches(1)
If teachOrSubject = "Teacher" Then
Cells(i, "C").Value = person
Else
Cells(i, "B").Value = person
End If
End If
Next
Next
End With
End Sub
The macro splits the string on a semicolon and stores either 1 or 2 substrings in the 'arr' array. It then does a regular expression on each one. If the string inside the parenthesis is "Teacher" then the preceding person's name is stored in column "C" otherwise it's a student and the name is stored in column "B".
I create a button that read all the registers you have on column A
then put the students on column B
then put the Teacher on column C
Check that I used "(Teacher)" to know when a teacher is in the String
I used the sheet Called "Sheet1"
And I don't use the first row because is the header row.
If you have any question please contact me.
Private Sub CommandButton1_Click()
'---------------------------------Variables-----------------------------
Dim total, i, j As Integer
'--------------Counting the number of the register in column A----------
ThisWorkbook.Sheets("Sheet1").Range("XDM1").Formula = "=COUNTA(A:A)"
total = CInt(ThisWorkbook.Sheets("Sheet1").Range("XDM1").Value)
'---------------------Creating arrays to read the rows------------------
Dim rows(0 To 1000) As String
Dim columnsA() As String
'------------Searching into the rows to find teacher or student---------
For i = 2 To total
columnsA = Split(ThisWorkbook.Sheets("Sheet1").Range("A" & i).Value, ";")
first = LBound(columnsA)
last = UBound(columnsA)
lenghtOfArray = last - first
MsgBox lenghOfArray
For j = 0 To lenghtOfArray
If InStr(columnsA(j), "(Teacher)") > 0 Then
MsgBox columnsA(j)
ThisWorkbook.Sheets("Sheet1").Range("C" & i).Value = columnsA(j)
Else
ThisWorkbook.Sheets("Sheet1").Range("B" & i).Value = columnsA(j)
End If
Next j
Next i
'--------------------------------Finishing------------------------------
End Sub
I am trying to calculate the count of Unique values based on a condition.
For example,
For a value in column B, I am trying to count the Unique values in Column C through VBA.
I know how to do it using Excel formula -
=SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))
that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name
This is my code :
Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))
This is the sample data with the requirement
Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.
I don't know where I am going wrong. Kindly share your thoughts.
You may try something like this...
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
Then you can use it like below...
=GetUniqueCount($A$2:$B$10,C2)
Where A2:B10 is the data range and C2 is the name criteria.
I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:
Sub Unique
dim arr(10) as variant, x as variant
dim arr2() as variant
for x = 1 to 10 ' or whatever
arr(x) = cells(x, 1) ' or whatever
next x
arr2 = UniqueValuesArray(arr)
' now write some code to count the unique values, you get the idea
End Sub
Function UniqueValuesArray(arr As Variant) As Variant()
Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long
arrpos = 0
ReDim uniqueArray(arrpos)
For x = 0 To UBound(arr)
If UBound(Filter(uniqueArray, arr(x))) = -1 Then
ReDim Preserve uniqueArray(arrpos)
uniqueArray(arrpos) = arr(x)
arrpos = arrpos + 1
End If
Next x
UniqueValuesArray = uniqueArray
End Function
I have a simple task that i need to automate.
I get a email in a very specific format from another application based on a trigger.
What i want is that out look "reads" the data in that email and compare two cells. if one cell is greater than the other, then i want the email forwarded to a specified address otherwise delete the email.
the folowing vba code was attempted, but gives a run time error. please guide
Sub GetLines()
Dim msg As Outlook.mailItem
Dim rows As Variant
Dim numberofColumns As Long
Dim numberofRows As Long
Dim headerValues As Variant
Dim headerRow() As String
Dim data() As String
Dim i As Long, j As Long
' get currently selected email
Set msg = ActiveExplorer.Selection.item(1)
' tokenize each line of the email
rows = Split(msg.Body, vbCrLf)
' calculate array size
numberofColumns = Len(rows(0)) - Len(Replace(rows(0), Chr(9), ""))
numberofRows = UBound(rows) + 1
' put header row into array
ReDim headerRow(1 To numberofColumns)
headerValues = Split(rows(0), Chr(9))
For i = 1 To numberofColumns
headerRow(i) = Trim$(headerValues(i - 1))
Next i
' calculate data array size
numberofRows = numberofRows - 1
' put data into array
ReDim data(1 To numberofRows, 1 To numberofColumns)
For i = 1 To numberofRows
For j = 1 To numberofColumns
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
End Sub
Your code makes too many unnecessary assumptions about the data and will give errors most of the time. Firstly you need to use F8 to step through the code to isolate the error in a particular line.
I suggest you change
Dim data() As String
to
Dim data As Variant
data = Array()
I'm not an expert in how VBA manages memory but I know that I get a lot less grief when I make things variants.
You are most likely to have a problem here:
For i = 1 To numberofRows
For j = 1 To numberofColumns
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
What if not every row is perfectly formed?
Instead, try this:
For i = 1 To numberofRows
For j = 1 To Ubound(Split(rows(i), Chr(9))) + 1
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
This allows your code to "survive" a blank line or some other error in the data.
Here my example of thing that i will use.
On the left side is the patch it will use NAME BASE REVISE to check the version of package.
Can you convert the script here in to VBA code. I will study about it and integrate to my real work:
if (Patch name = Pack name) then **** searching for same Name on patch column to reference for patch base and revise number
if (base(c column) > base(h column)) ***checknumber[cellbycell]
display "yes" in J cell
or if (base(C column) = base(h column)) then
check if revise(D column) > revise(I column)
display "yes" in J cell
else display No
So if you can give me example code ; if you have sometime please explain to me that what each line of code is meaning.
You don't need vba for this
=IF($A2=$G2,IF($C2>$H2,"Yes",IF($C2=$H2,IF($D2>$I2,"Yes","No"),"No")),"No")
That goes in column J
something like this should work:
Option Explicit
Sub variousconditions()
Dim i As Integer, x As Integer
x = 0
For i = 2 To 10
With Excel.ThisWorkbook.ActiveSheet
If .Cells(i, 1) = .Cells(i, 7) Then '****searching for same Name on patch
Select Case .Cells(i, 3) '***checknumber[cellbycell]
Case Is > .Cells(i, 8)
.Cells(i, 10) = "yes"
Case Is = .Cells(i, 8)
If .Cells(i, 4) > .Cells(i, 9) Then
.Cells(i, 10) = "yes"
End If
End Select
End If
End With
Next i
End Sub
I have to re-iterate Siddharth's reference as that will tell you where you need to save this code etc. : http://msdn.microsoft.com/en-us/library/office/ee814737%28v=office.14%29.aspx
Here is a function to compare two dot-notation version numbers which you'd need to paste into a new module in the VBA editor.
Option Explicit
Public Function VersionCompare(CurrentVersion As Range, _
TargetVersion As Range)
Dim result As Integer
result = CompareDotStrings(CurrentVersion.Cells(1, 1).Value, _
TargetVersion.Cells(1, 1).Value)
If result = 1 Then
VersionCompare = True
Else
VersionCompare = False
End If
End Function
Private Function CompareDotStrings(LeftValue As String, _
RightValue As String) _
As Integer
Dim CompareLeft() As String, CompareRight() As String, CompareLength As Integer
CompareLeft = Split(LeftValue, ".")
CompareRight = Split(RightValue, ".")
CompareLength = UBound(CompareLeft)
If UBound(CompareRight) < CompareLength Then CompareLength = UBound(CompareRight)
Dim ElementLeft As Integer, ElementRight As Integer, Comparison As Integer
Dim ElementNumber As Integer
For ElementNumber = 0 To CompareLength
ElementLeft = CInt(CompareLeft(ElementNumber))
ElementRight = CInt(CompareRight(ElementNumber))
Comparison = ElementRight - ElementLeft
If Comparison <> 0 Then
CompareDotStrings = Sgn(Comparison)
Exit Function
End If
Next ElementNumber
CompareDotStrings = 0
End Function
With this you can use =VersionCompare(H2, C2) to compare two version numbers and everything else you want to do (like splitting apart the dashed versions) can be done with formulas in the worksheet.