I am new on VBA and i dont know almost nothing.
I've been trying a code to find a value entered in a inputbox "CXRG", find on sheet "ESTOQUEV" cut all the line and paste on sheet "SAIDA" (down from another values) and erase the blank line from "ESTOQUEV"
Someone could help me?
Private Sub CommandButton1_Enter()
linha = Worksheets("SAIDA").Range("A100000").End(xlUp).Row + 1
Worksheets("SAIDA").Cells(linha, 1) = CXOS.Value
Worksheets("SAIDA").Cells(linha, 2) = CXRG.Value
CXOS.Text = ""
CXRG.Text = ""
SendKeys "{TAB}", True ' Envia TAB para pular par o inicio.
Call refresh.Macro8
End Sub
you have to try this code (run just findAndPast())
Sub findAndPast()
Dim shttoFind As Worksheet
Dim shttoPast As Worksheet
Dim LastRowOffind As Long
Dim inBox As String
Dim cell As Range
Set shttoFind = Worksheets("ESTOQUEV")
Set shttoPast = Worksheets("SAIDA")
Call Find_Last
LastRowOffind = shttoPast.Cells(shttoPast.Rows.Count, "A").End(xlUp).Row + 1
ActiveCell.EntireRow.Copy
shttoPast.Activate
shttoPast.Cells(LastRowOffind, 1).PasteSpecial
shttoFind.Activate
ActiveCell.EntireRow.Delete
End Sub
Sub Find_Last()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("ESTOQUEV").Range("A:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Related
I have this macro to replace special characters in any sheet in my workbook.
It gets rid of these characters: ! # # $ % ^ & () /
Sub Macro3()
Dim splChars As String
Dim ch As Variant
Dim splCharArray() As String
splChars = "! # # $ % ^ & () /" splCharArray = Split(splChars, " ")
For Each ch In splCharArray
Cells.Replace What:="~" & ch, Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=True
Next ch
End Sub
I need a second macro which would do Cells.Find for every cell in every worksheet then create a new sheet to list all cell addresses and special characters found.
On the web I found:
Public Sub SearchForText()
Dim rngSearchRange As Range
Dim vntTextToFind As Variant
Dim strFirstAddr As String
Dim lngMatches As Long
Dim rngFound As Range
On Error GoTo ErrHandler
vntTextToFind = Application.InputBox( _
Prompt:="Enter text to find:", _
Default:="Search...", _
Type:=2 _
)
If VarType(vntTextToFind) = vbBoolean Then Exit Sub
On Error Resume Next
Set rngSearchRange = Application.InputBox( _
Prompt:="Enter range for search:", _
Default:=ActiveCell.Parent.UsedRange.Address, _
Type:=8 _
)
On Error GoTo ErrHandler
If rngSearchRange Is Nothing Then Exit Sub
Set rngFound = rngSearchRange.Find( _
What:=CStr(vntTextToFind), _
LookIn:=xlValues, _
LookAt:=xlPart _
)
If rngFound Is Nothing Then
MsgBox "No matches were found.", vbInformation
Else
With ThisWorkbook.Sheets.Add
With .Range("A1:B1")
.Value = Array("Cell", "Value")
.Font.Bold = True
End With
strFirstAddr = rngFound.Address
Do
lngMatches = lngMatches + 1
.Cells(lngMatches + 1, "A").Value = rngFound.Parent.Name & "!" _
& rngFound.Address(0, 0)
.Cells(lngMatches + 1, "B").Value = rngFound.Value
Set rngFound = rngSearchRange.FindNext(rngFound)
Loop Until (rngFound.Address = strFirstAddr)
.Columns("A:B").AutoFit
End With
End If
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
End Sub
This code works. My problem is, I need to set a range in which it searches every time and it can only be one sheet, so essentially if I have 10 sheets I need to run this macro 10 times to get the desired result.
I would like to search for each character in every worksheet of my workbook, then create a new sheet and return the address of every cell in an entire workbook which contains any of my declared characters.
I thought I could declare new variable ws as worksheet and loop through all worksheets with the same range selected using for each.
Try this. You just need another loop for the worksheets, and a loop for the Find.
This code doesn't do any replacing.
Sub Macro3()
Dim splChars As String
Dim ch As Variant
Dim splCharArray() As String
Dim r As Range, s As String
Dim ws As Worksheet
splChars = "! # # $ % ^ & () /"
splCharArray = Split(splChars, " ")
Sheets.Add().Name = "Errors" 'to list characters and location
For Each ch In splCharArray
For Each ws In Worksheets
If ws.Name <> "Errors" Then
Set r = ws.Cells.Find(What:=ch, Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False)
If Not r Is Nothing Then
s = r.Address
Do
Sheets("Errors").Range("A" & Rows.Count).End(xlUp)(2) = ch 'character
Sheets("Errors").Range("B" & Rows.Count).End(xlUp)(2) = r.Address(external:=True)
Set r = ws.Cells.FindNext(r)
Loop Until r.Address = s 'loop until we are back to the first found cell
End If
End If
Next ws
Next ch
End Sub
My question is, why whenever I try to debug the error is
Runtime error 91; Object variable or with block variable not set.
I try to look at another example and try to find the solution in the forum but still, I cannot find it.
Btw, when I debug it will highlight at
findvalue.EntireRow.Delete
May I know what is the error ya? Hopefully, there is someone can explain it to me.
Thank you.
Private Sub cmdDelete_Click()
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer
Dim DataSH As Worksheet
Set DataSH = Sheet1
Dim x As Integer
Application.ScreenUpdating = False
If Emp1.Value = "" Or Emp2.Value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If
cDelete = MsgBox("Are you sure that you want to delete this training", _
vbYesNo + vbDefaultButton2, "Are you sure????")
If cDelete = vbYes Then
Set findvalue = DataSH.Range("B:B").Find(What:=Me.Emp1.Value, _
LookIn:=xlValues, LookAt:=xlWhole)
findvalue.EntireRow.Delete
End If
cNum = 7
For x = 1 To cNum
Me.Controls("Emp" & x).Value = ""
Next
DataSH.Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Data!$L$8:$L$9"), CopyToRange:=Range("Data!$N$8:$T$8"), _
Unique:=False
If DataSH.Range("N9").Value = "" Then
lstEmployee.RowSource = ""
Else
lstEmployee.RowSource = DataSH.Range("outdata").Address(external:=True)
End If
DataSH.Select
With DataSH
.Range("A2:G10000").Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess
End With
Sheet1.Select
On Error GoTo 0
Exit Sub
End Sub
You simply aren't finding the value from Me.Emp1.Value in column B of the Data worksheet so there is Nothing to delete. Maybe expand the Find arguments; matchcase:=false comes to mind.
Error controlled:
Set findvalue = DataSH.Range("B:B").Find(What:=Me.Emp1.Value, _
LookIn:=xlValues, LookAt:=xlWhole)
if not findvalue is nothing then findvalue.EntireRow.Delete
Alternate:
dim m as string
m = application.match(Me.Emp1.Value, DataSH.Range("B:B"), 0)
if not iserror(m) then DataSH.rows(m).entirerow.delete
Additional AdvancedFilter range definitions:
with DataSH
.Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L8:L9"), CopyToRange:=.Range("N8:T8"), _
Unique:=False
end with
I have some VBA experience, I can read and understand the coding, but have problems finding the proper codes.
Now, I have a userform where by the user would key in his ID, excel would then open up the database and search and return the results of the cells beside the found ID. the results would be returned and overwrite label 1 and label 2. And when the user clicks on the "next" or "previous" button, the next or previous results would then overwrite both labels.
The code I have right now allows me to search for the locations of the found ID and output the location in a format such as ($A$2,$A$3,$A$4,$A$6). The problem is that I am not sure what is the right functions that can then break this into individual range that the "next" or "previous" button can then refer to.
Have added my code
Dim cell As Range
Dim bcell As Range
Dim foundat As String
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
msgbox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = foundat
Exit Sub
You need to add two command buttons with name cmdNext & cmdPrev , label with name capproblem_output2 to run the below code. Copy the code to userform code section.
Public foundat As String
Private Sub cmdNext_Click()
capproblem_output.Caption = ActiveCell.Offset(1, 1)
capproblem_output2.Caption = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
End Sub
Private Sub cmdPrev_Click()
capproblem_output.Caption = ActiveCell.Offset(-1, 1)
capproblem_output2.Caption = ActiveCell.Offset(-1, 1)
ActiveCell.Offset(-1, 0).Select
End Sub
Private Sub CommandButton1_Click()
Main
End Sub
Sub Main()
Dim cell As Range
Dim bcell As Range
Dim oRange As Range
Dim userid As String
Dim x As Long
Dim y As Long
Dim Prob As String
Dim ws As Worksheet
Set ws = Worksheets("OFI")
Set oRange = ws.Columns(1)
userid = UserForm1.txt_user.Text
Set cell = oRange.Find(what:=userid, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
Set bcell = cell
foundat = cell.Address
Do
Set cell = oRange.FindNext(after:=cell)
If Not cell Is Nothing Then
If cell.Address = bcell.Address Then Exit Do
foundat = foundat & ", " & cell.Address
Else
Exit Do
End If
Loop
Else
MsgBox userid & "not found"
Exit Sub
End If
capproblem_output.Caption = Range(foundat).Offset(0, 1)
capproblem_output2.Caption = Range(foundat).Offset(0, 1)
End Sub
I am trying to build a macro which will find a column with the header "Total Labor" and delete all rows which have "0" in that column. I am generating multiple reports and the "Total Labor" column will change position so that's why I need the find. So far I have this code but when I run it nothing happens. Any help is appreciated.
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Set FoundCell = rng.Find(what:="0")
Do Until FoundCell Is Nothing
FoundCell.EntireRow.Delete
Set FoundCell = rng.FindNext
Loop
End Sub
First: if you set Application.ScreenUpdating = False be sure that you reset it to True before the sub ends. If your macro crashes you could find yourself unable to work with the application until you restart Excel or run another macro that sets Application.ScreenUpdating = True
Now, to answer your question: The problem with your code is that rng as defined in your code is only going to be the cell containing "Total Labor". When you search for a value of "0" in that range, the line Set FoundCell = rng.Find(what:="0") evaluates to "Nothing", so when you start the do loop, it meets the criterion of FoundCell Is Nothing and immediately goes to End Sub.
Something like this should do the trick:
Sub DeleteRows2()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'~~>dim variables and set initial values
Dim rTotalLaborHeader As Range
Set rTotalLaborHeader = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Dim rTotalLaborColumn As Range
Set rTotalLaborColumn = Range(Cells(2, rTotalLaborHeader.Column), Cells(1048576, rTotalLaborHeader.Column).End(xlUp))
'Set rTotalLaborColumn = Range(rTotalLaborHeader.Offset(1, 0), rTotalLaborHeader.End(xlDown))
Dim rLaborRow As Range
'~~>Loop to delete rows with zero Total Labor
For Each rLaborRow In rTotalLaborColumn
If rLaborRow.Value = 0 Then rLaborRow.EntireRow.Delete
Next rLaborRow
CleanupAndExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Resume CleanupAndExit
End Sub
How about:
Sub DeleteRow()
Dim colly As Long, killer As Range, nRow As Long
colly = 0
For i = 1 To Columns.Count
If Cells(1, i).Value = "Total Labor" Then
colly = i
Exit For
End If
Next i
If colly = 0 Then
MsgBox "Header not found"
Exit Sub
End If
nRow = Cells(Rows.Count, colly).End(xlUp).Row
For i = 1 To nRow
If Cells(i, colly).Value = 0 Then
If killer Is Nothing Then
Set killer = Cells(i, colly)
Else
Set killer = Union(killer, Cells(i, colly))
End If
End If
Next i
If killer Is Nothing Then
Else
killer.EntireRow.Delete
End If
End Sub
You need to replicate the FindAll functionality that the Excel UI Provides. Here's a code-list for achieving that in VBA. Save this to a .bas file, then call it in your macro after you locate 'Total Labor' and then look through the range you get back from FindAll and execute .Delete on them.
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
If rng Is Nothing Then
Msgbox "Total Labor Not Found"
Else
Set SearchRange = rng.EntireColumn
FindWhat = "0"
Set FoundCells = FindAll(SearchRange:=SearchRange, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
If FoundCells Is Nothing Then
Debug.Print "Value Not Found"
Else
For Each FoundCell In FoundCells
FoundCell.EntireRow.Delete
Next FoundCell
End If
End If
End Sub
FindAll Source Code: http://www.cpearson.com/excel/findall.aspx
Function FindAll(SearchRange As Range, _
FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False, _
Optional BeginsWith As String = vbNullString, _
Optional EndsWith As String = vbNullString, _
Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
XLookAt = xlPart
Else
XLookAt = LookAt
End If
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
For Each Area In SearchRange.Areas
With Area
If .Cells(.Cells.Count).Row > MaxRow Then
MaxRow = .Cells(.Cells.Count).Row
End If
If .Cells(.Cells.Count).Column > MaxCol Then
MaxCol = .Cells(.Cells.Count).Column
End If
End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
after:=LastCell, _
LookIn:=LookIn, _
LookAt:=XLookAt, _
SearchOrder:=SearchOrder, _
MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FirstFound = FoundCell
Do Until False ' Loop forever. We'll "Exit Do" when necessary.
Include = False
If BeginsWith = vbNullString And EndsWith = vbNullString Then
Include = True
Else
If BeginsWith <> vbNullString Then
If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
If EndsWith <> vbNullString Then
If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
End If
If Include = True Then
If ResultRange Is Nothing Then
Set ResultRange = FoundCell
Else
Set ResultRange = Application.Union(ResultRange, FoundCell)
End If
End If
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
If (FoundCell Is Nothing) Then
Exit Do
End If
If (FoundCell.Address = FirstFound.Address) Then
Exit Do
End If
Loop
End If
Set FindAll = ResultRange
End Function
I am trying to search for a particular string "ERROR" in all the worksheets in the workbook and make it bold and color the found cell red.
I am able to parse through each worksheet. I am not able to use the Find function of VBA.
Here's an example of using Find and formatting the found cells
Sub FindERROR()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "ERROR"
Application.FindFormat.Clear
' loop through all sheets
For Each sh In ActiveWorkbook.Worksheets
' Find first instance on sheet
Set cl = sh.Cells.Find(What:=SearchString, _
After:=sh.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
' if found, remember location
FirstFound = cl.Address
' format found cell
Do
cl.Font.Bold = True
cl.Interior.ColorIndex = 3
' find next instance
Set cl = sh.Cells.FindNext(After:=cl)
' repeat until back where we started
Loop Until FirstFound = cl.Address
End If
Next
End Sub
if you are searching in excel vba you can use following simple code with InStr command.
Private Sub CommandButton1_Click()
Dim RowNum As Long
RowNum = 1
Do Until Sheets("Data").Cells(RowNum, 1).Value = ""
If InStr(1, Sheets("Data").Cells(RowNum, 2).Value, TextBox1.Value, vbTextCompare) > 0 Then
On erro GoTo next1
ListBox1.AddItem Sheets("Data").Cells(RowNum, 1).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Sheets("Data").Cells(RowNum, 2).Value
End If
next1:
RowNum = RowNum + 1
Loop
End Sub
you can download example file from here
How about this:
If Not WorkBook.Sheets("Sheet1").Range("A1:Z150").Find("Cookie") Is Nothing
MsgBox "Found a Cookie"
End If