I have an extensive worksheet with company entries with each 5 attributes.
I’m looking to have the last update of each company. Thus, in the case of duplicates (when a company appears several times) to keep the latest entry.
The company name (which is the identifier) is in column A. Table has titles (row 6) and actual table start in row 7.
I’ve looked at the built in remove duplicates. But that leaves me with the first entry.
I’m really inexperienced when it comes to applying macros. Any help much appreciated
Tried built in remove duplicate and some commonly available macros. But none of them have worked so far
type here
Try this
Sub lastDublicate()
searchCol = "A" ' column for search
c = 7 ' first row for search
i = Cells(Rows.Count, 1).End(xlUp).Row + 1 'last row for search
searchEnd = ":" & searchCol & i 'last cell for search
searchValue = Range(searchCol & c).Value
arr = Range(searchCol & c + 1 & searchEnd).Value
Do While searchValue
IsInArray = IsNumeric(Application.Match(searchValue, arr, 0))
If IsInArray Then
Rows(Range(searchCol & c).Row).Delete
Else
c = c + 1
End If
searchValue = Range(searchCol & c).Value
arr = Range(searchCol & c + 1 & searchEnd).Value
Loop
End Sub
Related
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I am relatively new to Macros and VBA in Excel, so I need some guidance on how to solve my current issue.
The end goal of my project is to have a macro compare two sets of data organized into rows and columns (We'll say table A is the source data, and table B is based off of user input). Each row in table B should correspond to a row in table A, but they could be out of order, or there could be incorrect entries in table B.
My thought is that for the first row in each table, the macro would compare each cell left to right:
If Sheets("sheet1").Cells(2, 1) = Sheets("sheet2").Cells(2, 1) Then
If Sheets("sheet1").Cells(2, 2) = Seets("sheet2").Cells(2, 2)
Ect, ect.
My problem comes in when the Cell in table B does not match Table A.
First, I would want it to check B row 1 against the next row in A, and keep going throughout table A until it finds a "complete match" with all five columns of the row matching.
I've been trying to do this with Else if and For/Next staements
For row= 2 to 10
'if statements go here
Else If Sheets("sheet1").Cells(2, 1) <> Sheets("sheet2").Cells(2, 1)
Next row
I may be completely misunderstanding the syntax here, but I have yet to produce a situation where if the criteria is not met, it goes to the next row.
If no complete match is found, the last cell in table B row 1 that couldn't be matched should be highlighted.
Then regardless of whether a match was found or not, we would move to table B row 2, and start the whole process over.
So, I have the logic worked out (I think), where the comparison ifs would be inside a loop (or something) that would cycle through table A row by row. Then that whole process would be in another loop (or something) that would cycle through Table B.
At the end of the process, there would either be no highlighted cells showing that all entered data is correct, or cells would be highlighted showing data that do no match.
I am fairly certain that the cycling through table B is not the issue. Rather, I'm having difficulty getting the Macro to move to the next table A row if something doesn't match.
Please let me know if I need to elaborate on anything.
Thanks!
You could try:
Option Explicit
Sub test()
Dim Lastrow1 As Long, Lastrow2 As Long, i As Long, j As Long
Dim Str1 As String, Str2 As String
'Find the last row of sheet 1
Lastrow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
'Find the last row of sheet 2
Lastrow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
For i = 2 To Lastrow1
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str1 = Sheet1.Cells(i, 1).Value & "_" & Sheet1.Cells(i, 2).Value & "_" & Sheet1.Cells(i, 3).Value
For j = 2 To Lastrow2
'Let us assume that table has 3 columns. Merge 3 columns' values and create a string for each line
Str2 = Sheet2.Cells(j, 1).Value & "_" & Sheet2.Cells(j, 2).Value & "_" & Sheet2.Cells(j, 3).Value
'If both strings match a message box will appear
If Str1 = Str2 Then
MsgBox "Line " & i & " in table A match with line " & j & " in table B!"
Exit For
End If
Next j
Next i
End Sub
Sheet 1 structure:
Sheet 2 structure:
I have a sheet called "Table" where I have the table I'm looking up its A2:B20,
A2:A20 contains numbers in "XX" format these are the numbers I will be looking up.
The B2:B20 part of the table contains text is this text I want to use to replace values with.
I have my main sheet (currently called "Test") which contains my data, I want to look in Column M and check if I can find a value where the first 2 chars match any one of the values in A2:A20, if I do find a match I then want to replace the value of column F on my data sheet (Test) with the corresponding value from B2:B20 if not I want to leave it as is and move on.
I'm running into problems as the data in column M is numbers stored as text and it is replacing the wrong value when the table list 1 or 11 or 2 and 22.
'
Dim MyString As String
Counter = 2
1:
MyString = Sheets("Table").Range("A" & Counter).Value
For X = 1 To Range("M" & Rows.Count).End(xlUp).Row
If Replace(MyString, Left(Sheets("TEST").Range("M" & X).Value, 2), "") <> MyString Then Sheets("TEST").Range("F" & X).Value = Sheets("Table").Range("B" & Counter).Value
Next
Counter = Counter + 1
If Counter <= Range("M" & Rows.Count).End(xlUp).Row Then
GoTo 1:
Else
End If
End Sub
I solved my own problem, I was doing too much - simplified it forces values to .text and my issues went away.
Sub BBK_Name()
'Checks column U for start of data (1st 2 chars)
' if they match an entry in bank table changes entry in column G to match table entry.
'
Dim MyString As String
Counter = 2
1:
MyString = Sheets("Table").Range("A" & Counter).Text
RplcValue = Sheets("Table").Range("B" & Counter).Text
For X = 1 To Range("M" & Rows.Count).End(xlUp).Row
If Left(Sheets("TEST").Range("M" & X).Value, 2) = MyString Then _
Sheets("TEST").Range("F" & X).Value = RplcValue
Next
Counter = Counter + 1
If Counter <= Range("M" & Rows.Count).End(xlUp).Row Then
GoTo 1:
Else
End If
End Sub
I have 32.000 rows with data. Some data are in a different place and I want to join them with something that I can apply to all rows and not manually. Each "group" have the same ID, in this example is "XPTO"
I have something like this now (but with more columns):
I want it to be like this:
The problem is that I need a clever way, because they are not always exactly like this example. Some of them have 10 rows with the same ID "XPTO" (example)
I am struggling with this =/ ty
Here's how I would approach this.
1) From your comment, I understand that the logic is positional (the first one on the left (Casteloes de) goes with the first one on the right (R Dr Antonio) for the matching value in column A. If that is true, then I would insert a column where you start numbering sequentially, then Fill Down to get sequential numbers all the way to the end. This will help preserve the positional logic if you need to sort or rearrange your data. It will also help you with the logic of "first match", "second match", etc.
2) My next step would be to separate the two sets of data into separate tables/tabs (with the sequentially numbered column appearing in each) and use INDEX/MATCH. The recent answer here will help you with how to increment the match: Is there such thing as a VLOOKUP that recognises repeated numbers?
3) Alternative - this may even be easier, although you'll want to do extensive data checking to make sure nothing got screwed up. With the two tables from step 2, sort by any column with data in it, then delete the blank rows from each table. Then, sort each by the sequentially numbered column to return to the original order. At that point you may be able to just copy and paste. Check carefully for errors if you do this.
I am positive that the solution above given by CriketBird work, at least it has a good logic to solve it, but since I am a newbie in excel, I couldn't figure it out how to solve it that way.
So I solved it by using VBA in excel...(maybe I went too far for this simple problem, but it was my only option).
I will leave the code here if someone want it for a similar situation. (just select the first column and row your table starts and hit run)
Function Area(medico As String) As Integer
Do While countOk < 1
If medico = ActiveCell.Value Then
ActiveCell.Offset(1, 0).Select
rowCount = rowCount + 1
Else: countOk = 1
End If
Loop
Area = rowCount
End Function
Sub Teste()
Dim PaginaMedico As String
Dim totalrowCount As Integer
Dim rowCount As Integer
Dim countOk As Integer
Dim right As Integer
Dim left As Integer
Dim listaleft As New Collection
Dim listaright As New Collection
rowCount = 1
rowOk = 0
totalrowCount = 0
right = 0
left = 0
Do While ActiveCell.Value <> 0
PaginaMedico = ActiveCell.Value
rowCount = Area(PaginaMedico)
totalrowCount = totalrowCount + rowCount
Range("A" & (totalrowCount - (rowCount - 1))).Select
For i = ((totalrowCount + 1) - rowCount) To totalrowCount
If IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Empty"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
Range("T" & (i)).Value = "Full"
ElseIf Not IsEmpty(Range("E" & (i)).Value) And IsEmpty(Range("F" & (i)).Value) Then
left = left + 1
listaleft.Add i
ElseIf IsEmpty(Range("E" & (i)).Value) And Not IsEmpty(Range("F" & (i)).Value) Then
right = right + 1
listaright.Add i
End If
Next i
If Not (right = left) Then
Range("T" & totalrowCount).Value = "BOSTA"
right = 0
left = 0
End If
If listaleft.Count = listaright.Count Then
For i = 1 To listaleft.Count
Range("F" & listaright(1) & ":" & "S" & listaright(1)).Cut Range("F" & listaleft(1) & ":" & "S" & listaleft(1))
listaright.Remove (1)
listaleft.Remove (1)
Next i
End If
Set listaleft = New Collection
Set listaright = New Collection
Range("A" & (totalrowCount + 1)).Select
Loop
End Sub
this is my first time using the site, so forgive me for any inept explaining. I have a working macro to hide/unhide rows based on content of the rows, I just want it to be faster. Using a check box, when the box is checked, all rows with an "x" in column D get unhidden, those without an "x" get hidden. Same thing happens when it is unchecked, except it references column C, not D.
Right now, this code works. It's just a little slower than I'd like, since I'm sharing this with a bunch of people. Any ideas for how to speed it up? I'm pretty darn new to VB (the internet is astoundingly wise and a good teacher), but that doesn't matter. I already improved the code - before it selected each row, then referenced the column, and it was awful. Any ideas to speed it up (preferably without moving the screen) would be great.
Thanks so much folks,
DS
Sub NewLuxCheck()
Dim x As Integer
NumRows = Range("A42", "A398").Rows.Count
Range("A42").Select
If ActiveSheet.Shapes("checkbox2").OLEFormat.Object.Value = 1 Then
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("D" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
Else
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("C" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
End If
MsgBox ("Done")
End Sub
You could use array formula and let Excel to return array with row-numbers where 'x' value occures. It will be quicker but you'll have to reorganise your code and create separate functions etc.
Here example where array formula finds rows whre in column 'D' the cell has value 'x'. Then string of this row numbers is created in form of "A1,A5,A10" ...means 'x' was found in rows 1,5,10. And finally Range(rowsJoind).EntireRow.Hidden is used for all the rows to be hidden/un-hidden in one step.
For rows with value different then 'x' you'll have to use formula like '=IF({0}<>""x"", ROW({0}), -1)'.
Sub test()
Dim inputRange As Range
Dim lastRow As Long
Dim myFormula As String
Dim rowsJoined As String, i As Long
Dim result As Variant
With Worksheets("Base")
lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
Set inputRange = .Columns("D").Resize(lastRow)
Application.ReferenceStyle = xlR1C1
myFormula = "=IF({0}=""x"", ROW({0}), -1)"
myFormula = VBA.Strings.Replace(myFormula, "{0}", inputRange.Address(ReferenceStyle:=xlR1C1))
result = Application.Evaluate(myFormula)
result = Application.Transpose(result)
Application.ReferenceStyle = xlA1
For i = LBound(result) To UBound(result)
If (result(i) > -1) Then
rowsJoined = rowsJoined & "A" & result(i) & IIf(i < UBound(result), ",", "")
End If
Next i
.Range(rowsJoined).EntireRow.Hidden = False
End With
End Sub