I have a find method below:
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = Range("s4").Value
If Trim(FindString) <> "" Then
With Sheet3.Range("A:A") 'searches all of column A
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
'Application.Goto Rng, True 'value found
MsgBox Rng.Address
Else
MsgBox "Nothing found" 'value not found
End If
End With
End If
End Sub
but when I tried to change the range("a:a") to a variable it would give me an error. for example:
col = range ("a1").value 'a1 gives a,b,c,d or e
with Sheet3.Range(col:col) 'this would give me a compile error Expected : list separator or )
why is that?
Sheet3.Range(col:col) needs to be Sheet3.Range(col & ":" & col) then.
Alternatively you can use Sheet3.Columns(col).
Instead of sheet.range you can use column, It should work; So try this;
Sub select_column()
col = Range("A1").Value
Columns(col).Select
End Sub
Hope this Helps...
Related
Sub Find_Value()
Dim FindString As Double
Dim Rng As Range``
FindString = InputBox("Enter a search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("D:D")
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
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
the inputbox from the code has to read the barcode data which usually gives data in this format "0.00000E+12". However, my present code just reads numbers...what do i do ? i am new to vba so... please help :)
Try the next code, please:
Sub Find_Value()
Dim sh As Worksheet, FindString As String, Rng As Range, lastRow As Long
Set sh = sheets("Sheet1")
lastRow = sh.Range("D" & Rows.count).End(xlUp).Row
FindString = InputBox("Enter a search value")
If FindString = "" Then MsgBox "No input...": Exit Sub
FindString = Trim(FindString) 'to trim spaces if they exist in the copied string...
If Trim(FindString) <> "" Then
With sh.Range("D1:D" & lastRow)
.TextToColumns Destination:=.cells(1), FieldInfo:=Array(1, 2)
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
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
I'm hoping to achieve the following:
Take user input via the Input box.
Search the table headers for that text.
Filter the found column to remove all blank cells (Leaving just the cells with data in.)
I've progressed a bit with a script I found, to give the input box, search the table header and select the found cell.
I need to merge into this the step of filtering the column of the found cell. If I record the steps it filters the same column no matter what I search for, so I think I need a way of reading back the found cell details and choosing that column to filter out blanks.
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = Application.InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("ACM").Range("B2:DA2") ' This is the table headers
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
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
I now have it working using the following code, the only error I now get is a 1004 (WorksheetFunction class) error if I cancel the InputBox :-
Sub Find_First()
Dim i1 As Integer
Dim FindString As String
Dim Rng As Range
Dim rngData As Range
Set rngData = Application.Range("A2").CurrentRegion
FindString = Application.InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("ACM").Range("B2:DA2") ' This is the table headers
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
i1 = Application.WorksheetFunction.Match(FindString, Application.Range("A2:CZ2"), 0)
Rng.AutoFilter Field:=i1, Criteria1:="<>"
End Sub
Looks like you really need the autofilter worked out:
I've done this in a similar scenario:
Dim i1 as Interger
Dim rngData as Range
Set rngData = ws.Range("A1").CurrentRegion
Using Match to find my column number matching FindString
i1 = Application.WorksheetFunction.Match(FindString, ws.Range("A1:CZ1"), 0)
rngData.AutoFilter Field:=i1, Criteria1:="<>"
Is there a way that i can search a part of a description in a cell?
because when i search for a part like UTP he give's me an error
Got anny idea?
Here is my code
'search for a cbxItem_Nr or a cbx_Description
Sub Find_test_click()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Voer de product code in")
If Trim(FindString) <> "" Then
With Sheets("Magazijn").Range("A:B") 'searches all of column A and 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
Application.Goto Rng, True 'value found
Else
MsgBox "Opgegeven product Niet gevonden" '(MsgBox) Saying Did not find the product
End If
End With
End If
End Sub
In the code there are some dutch words
Not sure if I understood the question, but maybe try to use "xlPart" instead of "xlWhole" as lookAt-parameter.
I cannot find or create VBA code to allow pasting copied text from one cell in another sheet(sheet2) into a previously created comment in another sheet(sheet1).
Here is the code I have successfully compiled thus far, and I am stuck on how to get the text found into the comment box.
Sub For_Reals()
'Add Comment
Sheets("Sheet1").Range("F2").AddComment
Range("F2").Comment.Visible = False
'Find Value in Sheet2 based on Value from Sheet1
Dim FindString As String
Dim Rng As Range
FindString = Sheets("Sheet1").Range("F2").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet2").Range("C:C")
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
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
'Copy Value 4 cells to the right of found Value
Selection.Offset(0, 4).Copy
'Need Code to paste copied value in previously created comment
End Sub
Rather than copy and paste the cell value into the comment, you create the text at the same time as creating the comment box. If a comment box already exists an error is raised - so remove any comment boxes in that cell beforehand.
The VBA help gives this as an example:
Worksheets(1).Range("E5").AddComment "Current Sales"
So with this in mind, this code will do the trick:
Sub For_Reals()
'Find Value in Sheet2 based on Value from Sheet1
Dim FindString As String
Dim Rng As Range
FindString = Sheets("Sheet1").Range("F2").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet2").Range("C:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'Remove any existing comments, create comment and add text.
If Not Rng Is Nothing Then
Sheets("Sheet1").Range("F2").ClearComments
Sheets("Sheet1").Range("F2").AddComment Rng.Offset(0, 4).Value
Range("F2").Comment.Visible = True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Final code I ended up with is below. Added a loop to run through the column, and added a second reference to pull both the definition and description into the comment. Thank you Darren Bartrup-Cook for helping me out when I was stuck!
Sub Add_Comment_As_Def_Desc_Reference()
'Posted by Jeff Barrett 2015-04-10
Dim FindString1 As String
Dim Rng1 As Range
Dim sCommentText1 As String
Dim sCommentText2 As String
Dim str1 As String
Dim str2 As String
Dim cmmt As String
Dim i As Integer
str1 = "Definition: "
str2 = "Description: "
'Loop Code, must specify range for i based on # of FieldAlias
Sheets("Fields").Select
Range("F4").Select
For i = 4 To 59
'Find Definition & Description in NASDefs based on Value from FieldAlias
FindString1 = ActiveCell.Value
If Trim(FindString1) <> "" Then
With Sheets("NASDefs").Range("C:C")
Set Rng1 = .Find(What:=FindString1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End If
'Remove any existing comments, create comment and add text in FieldAlias
If Not Rng1 Is Nothing Then
ActiveCell.ClearComments
sCommentText1 = Rng1.Offset(0, 4).Value
sCommentText2 = Rng1.Offset(0, 5).Value
ActiveCell.AddComment.Text Text:=str1 & Chr(10) & Chr(10) & sCommentText1 & Chr(10) & Chr(10) & str2 & Chr(10) & Chr(10) & sCommentText2
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Shape.AutoShapeType = msoShapeRoundedRectangle
'Format lines of text
With ActiveCell.Comment.Shape.TextFrame
.Characters.Font.ColorIndex = 5
End With
Else
MsgBox "Nothing found"
End If
'End Loop
ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
Next i
'Resize Comment to fit text
'posted by Dana DeLouis 2000-09-16
Dim MyComments As Comment
Dim lArea As Long
For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 300
' An adjustment factor of 1.1 seems to work ok.
.Shape.Height = (lArea / 200) * 0.6
End If
End With
Next ' comment
End Sub
I want the macro to look for same value as in B2. And then copy the value from range D2:G2 to the found range. In this example D9:G9.
Thank you in advance :D.
I tried:
Sub Button1_Click()
Dim myRng1, myRng2 As Range, cell As Range
Set myRng1 = Range("A4:A1000")
Set myRng2 = Range("D2:G2")
myRng2.Select
Selection.Copy
For Each cell In myRng1
If Range("A2") = Range("A" & cell.Row) Then Range("D" & cell.Row).Select
ActiveSheet.Paste
Next cell
End Sub
Sub Find()
Dim Findcode As String
Dim Rng As Range
Range("A2:F2").Select
Selection.Copy
Findcode = Sheets("Sheet1").Range("a2").Value
If Trim(Findcode) <> "" Then
With Sheets("Sheet1").Range("A4:A60000")
Set Rng = .Find(What:=Findcode, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
ActiveSheet.Paste
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub