Merge 2 columns and find text VBA - excel

I have one table and one file. I can find the text which is in specific place in file inside the table.
However, the texts are not unique all the time, so I decided to combine 2 cells in file and try to find in table. unless, I cannot find a way to combine 2 columns in table to match it with combined 2 cells in file.
Below you may see example table.
my aim is adding date in cell next cell of Units. So I try to find A1234 instead of 1234 due to 1234 not unique.
FindString = wb.Sheets("1").Range("E4").Value & wb.Sheets("1").Range("E5").Value
If Trim(FindString) <> "" Then
With Wb2.Sheets("Sheet1").Range("A:A") 'this section need to be amended and need combine column A&B
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = wb.Sheets("1").Range("I4") ' if column A&B combining completed then next cell probably will not work
Else
MsgBox "Nothing found in the list"
End If

This is similar to the variant strategy mentioned in the comments-- Try looping through your data with a For loop and an If Statement looking for both values to match. Here's an example code that shows the concept
Sub test()
Dim s As Worksheet, findstring1 As String, findstring2 As String
Dim firstrow As Integer, lastrow As Integer, i As Integer
Set s = Sheets("test")
findstring1 = "A "'replace this with the Customer reference (what to search for)
findstring2 = "1234" 'replace this with the unit reference
firstrow = 2 ' row number for first cell with data
lastcell = s.Cells(2, 1).End(xlDown).Row 'find last cell row number (end of data)
For i = firstrow To lastcell
If s.Cells(i, 1) = findstring1 And s.Cells(i, 2) = findstring2 Then
'do something with found values
End If
Next i
End Sub

Related

Find and replace using VBA

I have a chart where I need to remove certain keywords from column C- Range C3:C5000(some cells are blank). The words that needs to be removed are placed in column A- Range A3:A100(some cells are blank). Both ranges gets changed for different files. I have written a code but its not working for dynamic range. Also I want to sort column c according to no. of characters in cell in Ascending order. please help
Sub Replace_Char()
Dim i As Integer
Dim Mpp As String
For i = 3 To 50
Mpp = Cells(i, 1).Value
If Cells(i, 1).Value <> 0 Then
Worksheets("Sheet1").Columns("C").Replace _
What:=Mpp, Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
End If
Next i
End Sub
For dynamic ranges, you can try using the .UsedRange property.
As for sorting by number of characters, create a column that has the formula like "=LEN(D1)" and then sort the sheet on that column.
Sub Replace_Char()
Dim i As Integer
Dim Mpp As String
'For i = 3 To 50
Dim Thing As Range
For Each Thing In ActiveSheet.UsedRange.Columns(1).Cells
Mpp = Cells(i, 1).Value
If Cells(i, 1).Value <> 0 Then
Worksheets("Sheet1").Columns("C").Replace _
What:=Mpp, Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
End If
'Next i
Next
End Sub

Look for a variable column header and insert a formula in the column under it

I am trying to do the following, without success.
I have two tabs, Counts and Input. what I need to do is to insert a formula that is basically a vlookup from the file codes in tab one to see that the codes generated every day (in tab 2) are matching them in the correct date.
my code so far does this:
ask to input the date that needs to be "update" = matched in tab 1. this part works and the macro finds the correct date. Now, what I am struggling with is to tell to the macro:
from the date you found, offset one row and insert the formula for all the non empty rows in the lookup column.
hereby my code. I think I am doing something wrong in the definition of such range, since is variable.
Thanks for all your help!
enter code here
Sub Macro2()
Macro2 Macro
Dim myValue As Date
myValue = InputBox("Please enter the date you want to update")
Sheets("Count").Range("A1").Value = myValue
Dim ra As Range
Dim date1 As Date
date1 = Range("A1")
Set ra = Cells.Find(What:=date1 _
, LookIn:=xlFormulas _
, LookAt:=xlPart _
, SearchOrder:=xlByRows _
, SearchDirection:=xlNext _
, MatchCase:=False _
, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Not found")
Else
'MsgBox (ra.Address)
Dim rws As Range
rws = Cells(Rows.Count, "B").End(xlUp).Row
Range(ra.Offset(1, 0) & rws).Formula = "=IFERROR(VLOOKUP($B3,'Input'!$B:$B,1,FALSE),"""")"
End If
End Sub
Your first issue is that you dim rws as range, but then try to assign a row number to it. A range holds a cell or a number of cells, but a row number is a numeric value. Therefore it will fail. Dim it as Long instead so it can hold a numeric value.
Secondly you try to offset your found cell by one, and then add the last row to it. If this is an attempt to use the whole range, this is not how it is done. The Offset property will return the value of the cell by default, not the cell itself, unless specified with .Address or anything of the sort. Also, you cannot assign a singular value or formula to a range at one go. This will have to be done with a loop instead.
Below code is my approximation to what you will need, if you answer my question in the comments I can refine this:
Sub Macro2()
Dim myValue As Date
myValue = InputBox("Please enter the date you want to update")
Sheets("Count").Range("A1").Value = myValue
Dim ra As Range
Dim date1 As Date
date1 = Range("A1")
Set ra = Cells.Find(What:=date1 _
, LookIn:=xlFormulas _
, LookAt:=xlPart _
, SearchOrder:=xlByRows _
, SearchDirection:=xlNext _
, MatchCase:=False _
, SearchFormat:=False)
If ra Is Nothing Then
MsgBox ("Not found")
Else
'MsgBox (ra.Address)
Dim rws As Long
Dim cel As Range
rws = Cells(Rows.Count, ra.Column).End(xlUp).Row
For Each cel In Range(Cells(ra.Offset(1, 0).Row, ra.Column), Cells(rws, ra.Column))
If cel <> "" Then cel.Formula = "=IFERROR(VLOOKUP($B" & (cel.Row - 2) & ",'Input'!$B:$B,1,FALSE),"""")"
Next cel
End If
End Sub

Select range with VBA - got stuck

I got little project in VBA and stuck on below topic.
I need to select range from searched value to first empty cell in H column.
Selected range should looks like this
Selected Range in Excel:
I searched for specific value in column A and if I found it it's being set as first cell in range. ( It works)
Then I need to find last cell in range which is first empty cell in last column.
This is what I've found and try to use
Sub Button()
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Worksheets("SS19").Activate
ActiveSheet.Range("A:A").Select
Set cell = Selection.Find(What:=StringToFind, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
cell.Select
With Worksheets("SS19")
Set rr = .Range(ActiveCell, .Cells(.Rows.Count, "H").End(xlUp))
With rr
rr.Parent.Range(.Cells(1, "A"), .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)).Select
End With
End With
If cell Is Nothing Then
Worksheets("SS19").Activate
MsgBox "String not found"
End If
I tried to searched for first empty cell in prevously selected range so it won't search the whole column but it doesn't work.
Try this...
Dim StringToFind As String
StringToFind = Application.InputBox("Enter string to find", "Find string")
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
With ws
Dim findCel As Range
Set findCel = .Range("A:A").Find(StringToFind, , , xlWhole, , , False, , False)
Dim lRow As Long
lRow = .Range(findCel.Address).Offset(, 7).End(xlDown).Row + 1
Dim rr As Range
Set rr = .Range("A" & findCel.Row & ":" & "H" & lRow)
rr.Select
End With
I find that using the worksheet's match function is easier than Range.Find when searching a single column.
Option Explicit
Sub Button()
Dim stringToFind As String, m As Variant
Worksheets("SS19").Activate
stringToFind = Application.InputBox("Enter string to find", "Find string", Type:=xlTextValues)
With Worksheets("SS19")
m = Application.Match(stringToFind, .Range("A:A"), 0)
If Not IsError(m) Then
If Not IsEmpty(.Cells(m + 1, "H")) Then
.Range(.Cells(m, "A"), .Cells(m, "H").End(xlDown).Offset(1)).Select
Else
.Range(.Cells(m, "A"), .Cells(m, "H").Offset(1)).Select
End If
End If
End With
End Sub
Using .End(xlDown) could be problematic if the first cell under row m in column H was blank and this should be checked for or you might find the selection reaching too far, possibly all the way down to the bottom of the worksheet. Checking for a non-blank cell will catch this potential problem.

VBA Excel - Search rows for string and if found copy entire cell to a specific location

I got 3000 rows of data in Excel.
Each row contains the same type of information but not in the right order.
What i need to do is to gather the same type of information under the same column.I would like to create a macro that is going to:
Search a row for a partial string (some values have similar strings but fall under different categories)
If the string is part of a cell copy the entire cell in a
new location
Repeat for the next row
Thanks in advance
Sub MoveColumns()
Dim LastRow As Long
Dim rFind As Range
Dim r As String
Dim m As Integer
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
MsgBox (LastRow)
For n = 1 To LastRow
r = n & ":" & n
Range(r).Select
With Range(r)
Set rFind = .Find(What:="Spain*", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
If rFind.Column < 6 Then
m = 6 - rFind.Column
Range(Cells(n, 1), Cells(n, m)).Insert Shift:=xlToRight
ElseIf rFind.Column > 6 Then
m = rFind.Column - 6
Range(Cells(n, 1), Cells(n, m)).Delete Shift:=xlToLeft
End If
End If
End With
Next
End Sub
UPDATED
If row doesn't contain any value starts with "Spain", this row is simply ignored and skipped.
I hope you can modify and customize the way suitable for your data.

How do I find the last column with data?

I've found this method for finding the last data containing row in a sheet:
ws.Range("A65536").End(xlUp).row
Is there a similar method for finding the last data containing column in a sheet?
Lots of ways to do this. The most reliable is find.
Dim rLastCell As Range
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
MsgBox ("The last used column is: " & rLastCell.Column)
If you want to find the last column used in a particular row you can use:
Dim lColumn As Long
lColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Using used range (less reliable):
Dim lColumn As Long
lColumn = ws.UsedRange.Columns.Count
Using used range wont work if you have no data in column A. See here for another issue with used range:
See Here regarding resetting used range.
I know this is old, but I've tested this in many ways and it hasn't let me down yet, unless someone can tell me otherwise.
Row number
Row = ws.Cells.Find(What:="*", After:=[A1] , SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Column Letter
ColumnLetter = Split(ws.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)
Column Number
ColumnNumber = ws.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Try using the code after you active the sheet:
Dim J as integer
J = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If you use Cells.SpecialCells(xlCellTypeLastCell).Row only, the problem will be that the xlCellTypeLastCell information will not be updated unless one do a "Save file" action. But use UsedRange will always update the information in realtime.
I think we can modify the UsedRange code from #Readify's answer above to get the last used column even if the starting columns are blank or not.
So this lColumn = ws.UsedRange.Columns.Count modified to
this lColumn = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1 will give reliable results always
?Sheet1.UsedRange.Column + Sheet1.UsedRange.Columns.Count - 1
Above line Yields 9 in the immediate window.
Here's something which might be useful. Selecting the entire column based on a row containing data, in this case i am using 5th row:
Dim lColumn As Long
lColumn = ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column
MsgBox ("The last used column is: " & lColumn)
I have been using #Reafidy method/answer for a long time, but today I ran into an issue with the top row being merged cell from A1-->N1 and my function returning the "Last Column" as 1 not 14.
Here is my modified function now account for possibly merged cells:
Public Function Get_lRow(WS As Worksheet) As Integer
On Error Resume Next
If Not IsWorksheetEmpty(WS) Then
Get_lRow = WS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim Cell As Range
For Each Cell In WS.UsedRange
If Cell.MergeCells Then
With Cell.MergeArea
If .Cells(.Cells.Count).Row > Get_lRow Then Get_lRow = .Cells(.Cells.Count).Row
End With
End If
Next Cell
Else
Get_lRow = 1
End If
End Function
Public Function Get_lCol(WS As Worksheet) As Integer
On Error Resume Next
If Not IsWorksheetEmpty(WS) Then
Get_lCol = WS.Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim Cell As Range
For Each Cell In WS.UsedRange
If Cell.MergeCells Then
With Cell.MergeArea
If .Cells(.Cells.Count).Column > Get_lCol Then Get_lCol = .Cells(.Cells.Count).Column
End With
End If
Next Cell
Else
Get_lCol = 1
End If
End Function
Here's a simple option if your data starts in the first row.
MsgBox "Last Row: " + CStr(Application.WorksheetFunction.CountA(ActiveSheet.Cells(1).EntireRow))
It just uses CountA to count the number of columns with data in the entire row.
This has all sorts of scenarios where it won't work, such as if you have multiple tables sharing the top row, but for a few quick & easy things it works perfect.

Resources