Find and replace values after looking up table - excel

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

Related

Loop through listbox rows if column is not empty copy paste to empty row in sheet

I'm trying to loop through listbox(attached picture below), and if the column(3) has value, then copy & paste row to empty row in excel sheet for later use.
I wanted to copy the row using column value to put it in sheet, but it just copys last row value, and repeats.
Could you please point out what I did wrong in the below code?
TIA
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.Column(3) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.Column(2)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.Column(1)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.Column(3)
s = s + 1
End If
Next i
Userform
Part of excel sheet
Few errors:
The index of your ListBox.Column is zero based, so you not looking at the third but second Index.
You are accessing the values wrongly, trying to read a full column so it seems. The correct syntax is expression.Column(pvargColumn, pvargIndex) so you are missing a parameter. Check the documentation remarks to see the difference between using the second parameter or not.
Make use of the iteration and the more common List property to access each row individually.
So therefor your code could look like:
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.List(i, 2) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.List(i, 1)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.List(i, 0)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.List(i, 2)
s = s + 1
End If
Next i
It is possible through the Column property too though:
s = 22
For i = 0 To Me.AnBox.ListCount - 1
If Me.AnBox.Column(2, i) <> "" Then
Sheets("SparePartsRequestForm").Range("A" & s).Value = Me.AnBox.Column(1, i)
Sheets("SparePartsRequestForm").Range("C" & s).Value = Me.AnBox.Column(0, i)
Sheets("SparePartsRequestForm").Range("D" & s).Value = Me.AnBox.Column(2, i)
s = s + 1
End If
Next i
Note: If your intention is to paste at the next available row, there are great ways to return the last used row of a range. See here for example

How to split a multivalue cells into multiple rows using a VBA?

I need to split cells into multiple rows without moving the cells in the ID column. The problem is that the list can be endless and the number of category's can be different and alose their can be information in column C which also have to stay on the same line as the ID cell.
Current and wanted results
https://imgur.com/a/rslXx4A
You could use a macro to loop through your info and print it in the new columns. Something like:
Sub delimit()
Dim cat As Range, c As Range, i As Long, nxt As Long
Set cat = ActiveSheet.Range(Range("B2"), Range("B65000").End(xlUp))
For Each c In cat
arr = Split(c.Value, ";")
For i = 0 To UBound(arr)
nxt = Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
Range("E" & nxt).Value = arr(i)
Next i
Next c
End Sub
The core thing we are using here is Split() which will turn a string into an array.
Syntax : Split ( expression [,delimiter] [,limit] [,compare] )
We loop through the category list, set to column "B", and make a new array for each cell.
Then we print this array in the column we want, in this example column "E".
But first, we print out the ID number in column "D", since we are currently aiming for that row.
If you also want to copy column "C" like we do "A", simply change the IF accordingly.
From
If i = 0 Then Range("D" & nxt).Value = c.Offset(0, -1)
to
If i = 0 Then
Range("D" & nxt).Value = c.Offset(0, -1)
Range("F" & nxt).Value = c.Offset(0, 1)
End If

Join rows based on unique ID

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

Nested For Next Loops: Outer loop not iterating

I have a range of data from A2:A34 with various names in it that I need to copy to the range E9:E14. I only need to copy and paste unique names (I don't need a double of the same name). I am pretty sure using a nested For Next loop is the way to go but I'm having trouble getting the outer loop to go to the next iteration. Right now this is only giving me the last name in the in range A2:A34 repeated in E9:14. I was looking into using Exit For but when I added that in the code, the outer loop iterated but then the inner loop started over at 2.
Any help with this would be greatly appreciated. Thanks!
Below is my code:
Sub FillTable()
Dim tableCount As Integer
Dim rowCount As Integer
For tableCount = 9 To 13
If Range("E" & tableCount).Value = "" Then
For rowCount = 2 To 34
If Range("E" & tableCount).Value = Range("A" & rowCount).Value Then
ElseIf Range("E" & tableCount).Value <> Range("A" & rowCount).Value Then
Range("E" & tableCount).Value = Range("A" & rowCount).Value
End If
Next rowCount
End If
Next tableCount
End Sub
I am not sure if VBA is really needed for this exact issue but hopefully the below code will help. I switched the loops so that you only iterate through the large list of names once and then you iterate through the second list checking for duplicates. I also added a variable so it would allow for more than 5 unique names (unlike when tablecount was 9 to 13).
Fair warning - this is a quick and easy solution. It is neither elegant nor optimized.
Sub FillTable()
Dim tableCount As Integer
Dim rowCount As Integer
Dim n As Integer
n = 0
For rowCount = 2 To 34
For tableCount = 9 To 9 + n
If Range("E" & tableCount).Value = Range("A" & rowCount).Value Then
' name already found, break out of loop
Exit For
ElseIf Range("E" & tableCount).Value = "" Then
Range("E" & tableCount).Value = Range("A" & rowCount).Value
n = n + 1
End If
Next tableCount
Next rowCount
End Sub
It seems that your description of your goal does not match the code.
You are copying from (to simplify a bit) col A to col E.
Does col E already contain data? If not, why the first "if" stmt to see if some cell is empty?
If yes, E already contains data, then you want to loop through E to see if E already contains the new name.
I'll also point out that E has room (per your spec) for 6 names, while the source has 33 names.
Without knowing your goal, I won't suggest real code, but, perhaps a way of approaching the problem:
Create functions that do only very simple little things. For example, perhaps simplest, a function to see if name already in list. Note that I assume a value for highest used row, be sure to define it, whether as 14, or as some counter.
Function Is_Name_Already_Present_in_E( Name-to-check as String ) As Bool
Is_Name_Already_Present_in_E = False ; Default we'll return if don't find name.
for r = 9 to highest-so-far-used
if Name-to-check = Range( "E" & r ).value then ; If found name in list,
Is_Name_Already_Present_in_E = true ; then return true.
exit function
end if
next r
end function ; If scan whole list, and not found,false.
I'm sure there are a few syntax errors, but they should be easy to resolve.
Then, create a simple function to add your new name to E. Perhaps something like (Beware the assumptions!):
Function Add_New_Name_To_List( Name as string ) as bool
if highest_used_so_far >= 14 then
Error "No room to insert name:" & Name & ". Rejected."
Add_New_Name_To_List = false
exit function
end if
highest_used_so_far = highest_used_so_far + 1
range( A & h_u_s_r ).value = Name
Add_New_Name_To_List = true
exit function
Then, your main becomes a very simple (fake code example because I don't know your intent):
for r = 2 to 34
if not Is_Name_Already_Present_in_E( range( "A" & r ).value ) then
if not Add_Name_to_E( range( "A" & r ).value ) then
... what to do if add fails. ...
end if
end if
next name
Break your problem into pieces and it should be clear how to write each piece. Good luck.

Delete Excel record when value ends with plus sign ('+')

We have a blank workbook which I would like the user to be able to paste a list of reference numbers into column A. Some of these reference numbers will have a "+" at the end.
Sub texter1()
With Sheets("texter")
ll = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To ll
If InStr(1, .Range("a" & i).Value, "+", 1) Then
.Range("b" & i).Formula = "=LEFT(A" & i & ", LEN(A" & i & ")-1)"
.Range("c" & i).Value = Sheets("texter").Range("b" & i).Value
.Range("d" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,14,FALSE)"
.Range("e" & i).Formula = "=VLOOKUP($c" & i & ", _
[Current_Master.xlsm]Master!$A$3:$BB$20000,15,FALSE)"
Else
Cells(i, "a").EntireRow.Delete
End If
Next i
End With
End Sub
I would like reference numbers without the "+" to have the whole row deleted. Reference numbers with a "+" work fine.
this seems to work but has to be run multiple times for it to delete all the rows without a "+" and I cannot figure out why. Please help
Thank you
You cannot delete a row inside a loop as far as affects the iterations. Imagine this: you have 4 rows; the second row meets the conditions and is deleted; in the next iteration the counter is 3 but the row number 3 is now the fourth row (when you delete a row, all the ones below go up one position); consequently, row number 3 wouldn't be analysed. Thus the solution is simple:
Cells(i, "a").EntireRow.Clear()
If you want to actually delete the whole row, you would have to do it outside the main loop. For example: store all the rows to be deleted in an array and iterate through this array right after completing the main loop.
Another alternative would be performing the iterations in the main loop in inverse order (from maximum row to minimum one), although this option is not always applicable (not sure if in your case) and might provoke further problems. The two options above are good enough, I have mentioned this last alternative just as something worthy to be known.
--- UPDATE
To delete the rows after the main loop you can use something on these lines:
'Declaration of variables
ReDim allRows(ll + 1) As Long
Dim allRowsCount As Long: allRowsCount = 0
In your main loop you store the given rows (where you have now Cells(i, "a").EntireRow.Delete):
For i = 1 To ll
'etc.
else
allRowsCount = allRowsCount + 1
allRows(allRowsCount) = i
After the loop is completed, you go through all the stored rows (in inverse order) and delete them:
If (allRowsCount > 0) Then
Dim curRow As Long: curRow = allRowsCount + 1
Do
curRow = curRow - 1
.Rows(allRows(curRow)).Delete
Loop While (curRow > 1)
End If
End With
End Sub

Resources