What's the most efficient way to search for a partial string in a worksheet?
I'm trying to search for "N " in C4 through the end of column C of the active sheet. If "N " does not appear in the array then I want to close the file. If "N " does appear I want to print a message saying "Force data found"
I know you could use the countif function, sum up the times it appears, and then use if/then to determine action -- but I imagine there's a better way. Thoughts?
My code below does a search for "N " in the worksheet and then deletes the rows where it is not present. Note: I want to include the 3 spaces after the N in the search
Image here:
Sub InspectColumn()
'Define variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long
Dim Res As Variant
' Define LastRow as the last row of data based on column C
LastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
' Sets check range as C1 to the last row of C
Set cRange = Range("C1:C" & LastRow)
' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
' find if 'N ' found in any cell in the row
Res = Evaluate("COUNTIF(" & x & ":" & x & ", ""*N *"")")
' if 'N ' not found delete row
If Res = 0 Then
ActiveSheet.Rows(x).Delete
End If
Next x
End Sub
Something along these lines. I've put in as an answer, but will need some tweaking.
Columns("A:A").AutoFilter Field:=1, Criteria1:="<>*N*"
Columns("A:A").SpecialCells(XlCellType.xlCellTypeVisible).EntireRow.Delete
Columns("A:A").AutoFilter
Related
I'm quite new with vba and would need your precious help.
I want to copy paste a range after the last row if I can't find a match between column B in sheet "all" and column A in sheet "FY23".
My goal is for it to copy paste the range the number of times there's not a match. So if there's 3 values not found in column B it should copy paste 3 times and with my current code it only copy pastes once...
I also want to add the values that are not found in the second cell of the first row copied, not sure how to do that either.
e.g. i can't find "hello" on column B so it will copy paste my range and add "hello" to the 2nd cell of the first row copied.
Thank you a lot in advance.
Sub copypaste()
Dim all As Worksheet, fy23 As Worksheet
Dim allLastRow As Long, fy23LastRow As Long, x As Long
Dim dataRng As Range
Set all = ThisWorkbook.Worksheets("ALL")
Set fy23 = ThisWorkbook.Worksheets("FY23")
allLastRow = all.Range("B" & Rows.Count).End(xlUp).Row
allLastRow = allLastRow + 3
fy23LastRow = fy23.Range("A" & Rows.Count).End(xlUp).Row
Set dataRng = fy23.Range("A2:A" & fy23LastRow)
For x = 2 To allLastRow
On Error Resume Next
If Not all.Range("B" & x).Value = Application.WorksheetFunction.Vlookup(all.Range("B" & x).Value, dataRng, 1, False) Then
Sheets("ALL").Range("A1:BB22").Copy
Sheets("ALL").Range("A" & allLastRow).PasteSpecial
End If
Next x
End Sub
Attempting to write some vba but not having much luck. I have column A with a whole list of values that I am counting and looping through. For Each value in column A, there can be a match in range C:D. If a value in column A matches a value in column C. I want to insert the corresponding value in column D below the Column A value. I am not too certain on what my IF then statement should look like. I have my counter and loop... I am just unsure where to go with the middle portion of the code.
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ef
IF (UNSURE WHAT TO PLACE HERE!) THEN
Next i:
End Sub
Edit: adding sample data
Sample Data screenshot
In this example, I would like to insert a new row under the value in "A" where A=C. ie. Range in column "A" = Range in Column "C". I would like to then insert the value from "D". The new order in rows 4-6 would be:
Range
Order Group 1
2604291
I already have written the code to manually move my sheets around to follow the specific order once I am able to get the names in said order.
I agree with #BigBen that the simpler approach would be to insert a formula in column D that only replicates the column A value when a match is detected. Such a formula would probably look like the following -
=IF($A1=$C1,$A1,"")
This would be copied into cell D2 of your column and copied down as far as needed.
However, if you did want to achieve this with VBA and I have noted you used the word insert a value (as opposed to simple enter a value or copy & paste a value) then this could be your approach -
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Dim i As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = ef To 1 Step -1
If wp.Range("A" & i).Value = wp.Range("C" & i).Value Then
wp.Range("D" & (i + 1)).Insert xlShiftDown
wp.Range("D" & (i + 1)).Value = wp.Range("A" & i).Value
Else
End If
Next i
End Sub
This approaches the problem in reverse by going up your column instead of going down. Note that by inserting your data, will cause each previous value to move down as well. If you don't want this, then simply erase the .Insert line and it will enter the value instead of inserting a cell.
Modify the below code and use:
Formula:
=IFNA(VLOOKUP(A1,$C$1:$D$5,2,0),"Missing")
VBA Code:
Option Explicit
Sub test()
Dim rngSearch As Range, rngFound As Range
Dim LastRowA As Long, LastRowC As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rngSearch = .Range("C1:D" & LastRowC)
For i = 1 To LastRowA
Set rngFound = rngSearch.Find(.Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not rngFound Is Nothing Then
.Range("B" & i).Value = .Range("D" & rngFound.Row).Value
Else
.Range("B" & i).Value = "Missing"
End If
Next i
End With
End Sub
Result:
Excel 2010. I am trying to write a macro that could copy a set of data multiple times based on criteria on another sheet, but I've been stuck for a long time. I very much appreciate any help that could be offered to help me solve this problem.
Step 1: In the "Criteria" worksheet, there are three columns in which each row contains a specific combination of data. The first set of combination is "USD, Car".
Criteria worksheet
Step 2: Then the macro will move to the Output worksheet (please refer to the below link for screenshots), and then filter column A and B with the first set of criteria "USD" and "Car" in the "Criteria" worksheet.
Step 3: Afterwards, the macro will copy the filtered data into the last blank row. But the tricky part here is that, the filtered data has to be copied two times (as the "Number of set" column in the "Criteria" tab is 3 in this combination, and it doesn't have to copy the data three times since the filtered data would be treated as the first set of data)
Step4: After the filtered data have been copied, the "Set" column D will need to fill in the corresponding number of set that the rows are in. Therefore, in this 1st example, cell D2 and D8 will have "1" value, cell D14-15 will have "2" value, and cell D16-17 will have "3" value.
Step5: The macro will then move back to the "Criteria" worksheet and continue to based on the 2nd set of combination "USD, Plane" to filter the data in the "Output" worksheet. Again, it will copy the filtered data based on the "Number of set" in the "Criteria" worksheet. This process will continue until all the different combinations in the "Criteria" worksheet have been processed.
Output worksheet
Ok sorry for delay, here is a working version
you just have to add a sheet called "BF" because the autofilter count wasn't working properly so I had to use another sheet
Sub testfct()
Dim ShC As Worksheet
Set ShC = ThisWorkbook.Sheets("Criteria")
Dim EndRow As Integer
EndRow = ShC.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
Get_Filtered ShC.Cells(i, 1), ShC.Cells(i, 2), ShC.Cells(i, 3)
Next i
End Sub
Sub Get_Filtered(ByVal FilterF1 As String, ByVal FilterF2 As String, ByVal NumberSetsDisered As Integer)
Dim NbSet As Integer
NbSet = 0
Dim ShF As Worksheet
Set ShF = ThisWorkbook.Sheets("Output")
Dim ColCr1 As Integer
Dim ColCr2 As Integer
Dim ColRef As Integer
ColCr1 = 1
ColCr2 = 2
ColRef = 4
If ShF.AutoFilterMode = True Then ShF.AutoFilterMode = False
Dim RgTotal As String
RgTotal = "$A$1:$" & ColLet(ShF.Cells(1, Columns.Count).End(xlToLeft).Column) & "$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row
ShF.Range(RgTotal).AutoFilter field:=ColCr1, Criteria1:=FilterF1
ShF.Range(RgTotal).AutoFilter field:=ColCr2, Criteria1:=FilterF2
'Erase Header value, fix? or correct at the end?
ShF.AutoFilter.Range.Columns(ColRef).Value = 1
Sheets("BF").Cells.ClearContents
ShF.AutoFilter.Range.Copy Destination:=Sheets("BF").Cells(1, 1)
Dim RgFilt As String
RgFilt = "$A$2:$B" & Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row '+ 1
Dim VR As Integer
'Here was the main issue, the value I got with autofilter was not correct and I couldn't figure out why....
'ShF.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
'Changed it to a buffer sheet to have correct value
VR = Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row - 1
Dim RgDest As String
ShF.AutoFilterMode = False
'Now we need to define Set's number and paste N times
For k = 1 To NumberSetsDisered - 1
'define number set
For j = 1 To VR
ShF.Cells(Rows.Count, 1).End(xlUp).Offset(j, 3) = k + 1
Next j
RgDest = "$A$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":$B$" & (ShF.Cells(Rows.Count, 1).End(xlUp).Row + VR)
Sheets("BF").Range(RgFilt).Copy Destination:=ShF.Range(RgDest)
Next k
ShF.Cells(1, 4) = "Set"
Sheets("BF").Cells.ClearContents
'ShF.AutoFilterMode = False
End Sub
And the function to get column letter using an integer input :
Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function
This is some VBA code I've written for Excel. I'm trying to match entries in Sheet1 with those in Sheet2. The structure of both sheets is as follows:
DATE | ID |
----- ----
Date1 ID1
Date2 ID2...
In my code, I loop through the rows of the first sheet, and set the values from each particular row as part of my MATCH() query, in hopes of finding these same values in the second sheet. When I do, I want MATCH() to return the row index it finds these values in, so I can use that same row to input further information from the first sheet. This query uses multiple criteria, as indicated by both the value and searchRange variables (I'm trying to use the multiple criteria via concatenation method, as seen in this article).
The problem is, I consistently get a WorksheetFunction.Match could not be used error. When I used one single criteria (the ID), the function worked. When I tried to use multiple ones, it failed, even though I followed the instructions seen in the previously linked article. Any suggestions or ideas to fix this would be appreciated.
Sub runComparison(Sheet1 As String, Sheet2 As String)
Dim rowCount As Variant, columnCount As Variant, information As Variant
Dim counter As Integer
Dim value As String, searchRange As String
Sheets(Sheet2).Select
'Array of the number of rows in both sheets
rowCount = Array(Sheets(Sheet1).Cells(Rows.count, "A").End(xlUp).row, Sheets(Sheet2).Cells(Rows.count, "A").End(xlUp).row)
'Array of the number of columns in both sheets
columnCount = Array(Sheets(Sheet1).Cells(1, Columns.count).End(xlToLeft).Column, Sheets(Sheet2).Cells(1, Columns.count).End(xlToLeft).Column)
'The range in which we will look for the date and the ID
searchRange = CStr(Range(Cells(2, 1), Cells(rowCount(1), 1)).Address & "&" & Range(Cells(2, 2), Cells(rowCount(1), 2)).Address)
counter = 2
Do Until counter = rowCount(0)
'Sets the search term equal to the current cell in Sheet1
value = Sheets(Sheet1).Cells(counter, 1) & "&" & Sheets(Sheet2).Cells(counter, 2)
' Attempts to set the cell in the 8th column in the same row in which the search term is found equal to a certain value from the search term's row
Cells(WorksheetFunction.Match(value, searchRange, 0), 8) = Sheets(Sheet1).Cells(counter, columnCount(0)).value
counter = counter + 1
Loop
End Sub
Edit: Here's some sample input
value = '7/14/2014&ESTUOUW1046465464'
searchRange = '$A2:$A298&$B2:B298'
UPDATED
Thanks for clarifying in comments. I removed my original answer as it pertains only to the regular "Match" function, and I see the reference/example and understand what you're trying to do now which involves an array formula.
Let's try this using Application.Evaluate which will avoid the need to put this formula in a cell. Using the example data from MS, I did this which seems to work:
Sub test()
Dim value As String
Dim srcRange As String
value = "D2&E2"
srchRange = "$A$2:$A$5&$B$2:$B$5"
Debug.Print Application.Evaluate("=MATCH(" & value & "," & srchRange & ",0)")
End Sub
Applying that in your code, I think would be like below. YOu will still want to Dim matchVal as Variant to hold the result of the formula evaluation, I think. Then do this:
Do Until counter = rowCount(0)
'Sets the search term equal to the current cell in Sheet1
value = Sheets(Sheet1).Cells(counter, 1) & "&" & Sheets(Sheet2).Cells(counter, 2)
'## Assign the result of the Match function to a variable
matchVal = Application.Evaluate("=MATCH(" & value & "," & searchRange & ",0)")
'## Check for errors, and handle as needed:
If IsError(matchVal) Then
'modify as needed, this highlight the cell with the non-matched value
' you might omit this line and simply ignore it, or you could
' display a MsgBox prompt, etc.
Sheets(Sheet1).Cells(counter, columnCount(0)).Interior.ColorIndex = 6
Else:
Cells(matchVal, 8) = Sheets(Sheet1).Cells(counter, columnCount(0)).value
End If
counter = counter + 1
Loop
I'm trying to find the last row in column A that contains a value with the following code:
LastRow = DataWorksheet.Range("A:A").Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
This works fine for most cases, except when the last few rows are filtered out. For instance, let's say we have 30 rows of data. If rows 1-10 are visible, 11-20 are filtered out, and 21-30 are visible, it finds the last row successfully: it returns 30. When everything is visible and rows 21-30 are filtered out, LastRow returns 1.
Note that if I manually hide instead of filtering out rows 21-30, it tells me that the last row is 20.
What gives? How can I make it determine what the last row is if the last rows are filtered?
Edit: Now it seems as though LastRow is picking out the last unfiltered row, which is a definite departure from its previous behavior. I'll update this post once I'm better able to isolate the bug/inconsistency I'm encountering.
These should ignore filtering / visibility and give you the last used row number:
DataWorksheet.UsedRange.Rows.Count
-or-
DataWorksheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
Neither will find the last used cell in column A, however... is that what you need?
This works on sheets with both hidden rows and autofilters. It will also NOT give you the incorrect row if a cell below the last cell with a value has been formatted (which will cause the usedrange to be greater than the row you are looking for).
Sub FindLastRowWithValue()
Dim ws As Worksheet
Dim temp As Worksheet
Dim lastrow As Long
' copy the sheet that may have hidden rows
Set ws = Sheets("Sheet1")
ws.Copy Before:=Sheets(1)
Set temp = ActiveSheet
' turn off autofiltering if need be
If temp.AutoFilterMode Then temp.AutoFilterMode = False
' unhide all rows
temp.Columns("A:A").EntireRow.Hidden = False
' get the last row with a value now that all rows are unhidden
lastrow = temp.Range("A" & temp.Rows.Count).End(xlUp).Row
' delete the temporary sheet
Application.DisplayAlerts = False
temp.Delete
Application.DisplayAlerts = True
MsgBox lastrow
End Sub
How about this (as a sort of work around on XL's limitations). It's kind of long / clunky with the loop, but at least the loop starts at the first visible last cell.
LastRow = DataWorksheet.Range("A:A").Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
If LastRow <> DataWorksheet.UsedRange.Rows.Count 'assumes data starts in A1, if not adjust acoordingly
'now check if there is anything below
Dim rngSearch as Range
rngSearch = DataWorksheet.Range("A" & LastRow & ":A" & DataWorksheet.UsedRange.Rows.Count)
Dim lngRows as Long, lngCnt as Long
lngRows = rngSearch.Rows.Count
For lngCnt = lngRows to 1 Step -1
If DataWorksheet.Range("A" & lngCnt) = vbNullString And DataWorksheet.Range("A" & lngCnt -1) <> vbNullString Then
LastRow = DataWorksheet.Range("A" & lngCnt-1).Row
End If
Next
End If
After a lot of frustration, looks like there is always issues with "vba built-in" methods. For example, with column "A", and "WS" being a WorkSheet Object :
« Ws.Cells(WS.Rows.Count,1).End(xlUp) » fails with hidden rows
« WS.Range("A1").Find(...) » fails when there is rows hidden in groups (and maybe other circumstances)
« UsedRange » and « .SpecialCells(xlLastCell) » can return a result higher than expected
My solution was to use an excel formula with "WorkSheet.Evaluate".
To check for non-empty value (i.e. a formula with an empty result WILL NOT be considered) :
Function FindLastRow(R as Range) As Long
Const NotFoundResult = 1 ' If all cells have an empty value, this value is returned
FindLastRow = R.Worksheet.Evaluate("IFERROR(LARGE(ROW('" & R.Worksheet.Name & "'!" & R.Address & ")*--('" & R.Worksheet.Name & "'!" & R.Address & " <> """"),1)," & NotFoundResult & ")")
End Function
To check for the last cell with a formula OR a value (even if the result is empty) :
Function FindLastRow(R as Range) As Long
Const NotFoundResult = 1 ' If all cells are empty (no value, no formula), this value is returned
FindLastRow = R.Worksheet.Evaluate("IFERROR(LARGE(ROW('" & R.Worksheet.name & "'!" & R.Address & ")*--(NOT(ISBLANK('" & R.Worksheet.name & "'!" & R.Address & "))),1)," & NotFoundResult & ")")
End Function
I assume that Slothario's sheet has a simple structure, with the following key features:
The last populated cell in column A is also the last populated row of the sheet (at least when no rows are hidden or filtered out).
There is something in row 1
In that case, here are two simple ways to identify the different kinds of 'last row':
Cells.SpecialCells(xlLastCell).Row 'Last row that is not hidden or filtered out
Activesheet.UsedRange.Rows.Count 'Last row with a value in it (even if the row is hidden; only gives right answer if row 1 is nonblank)
If the top row/rows might be blank, the second option needs to be modified to this:
Activesheet.UsedRange.Rows.Count + Activesheet.UsedRange.Row -1 'Last row with a value in it (even if the row is hidden)
I use this all the time to get the last row, not 100% sure it works for hidden cells though :)
P.S. make sure to change the sheet name when testing
'VBA to find last row
lngLastRow = ThisWorkbook.Worksheets("Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Public Function lr(ByVal source As Worksheet, colu As Long) As Long
Dim tmp As Long
tmp = source.Cells(source.Rows.Count, colu).End(xlUp).Row
While source.Cells(tmp + 1, colu).EntireRow.Hidden = True
tmp = tmp + 1
Wend
lr = tmp
End Function