You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
VBA search with variable
- Thread starter govi
- Start date
Hi,
In Sheet 1 add a named range (eg Search). his is where you will put the variable.
Then in VB add:
Sub Search()
' Search Macro
Dim Search As String
Search = Range("Search").Value
Sheets("Sheet2").Select
Columns("C:C").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub
Myles
In Sheet 1 add a named range (eg Search). his is where you will put the variable.
Then in VB add:
Sub Search()
' Search Macro
Dim Search As String
Search = Range("Search").Value
Sheets("Sheet2").Select
Columns("C:C").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End Sub
Myles
Hi,
I've just had a little play with it. Worth changing the LookIn:=xlFormulas to LookIn:=xlValues and adding an error catch. Revised code below:
Sub Search()
' Search Macro
Dim Search As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Sheet2").Select
Columns("C:C").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Exit Sub
ErrorCatch:
MsgBox "Search item not found"
End Sub
I've just had a little play with it. Worth changing the LookIn:=xlFormulas to LookIn:=xlValues and adding an error catch. Revised code below:
Sub Search()
' Search Macro
Dim Search As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Sheet2").Select
Columns("C:C").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Exit Sub
ErrorCatch:
MsgBox "Search item not found"
End Sub
Hi,
That a good one but I still have another problem:
There are a couple of actions the macro performs after it has found the record.
If it doesn't find the record is must not perform those actions.
How can I realize that?
[pre]
[/pre]
That a good one but I still have another problem:
There are a couple of actions the macro performs after it has found the record.
If it doesn't find the record is must not perform those actions.
How can I realize that?
[pre]
Code:
Sub Search()
' Search Macro
Dim Search As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("data").Select
Columns("L:L").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Exit Sub
ErrorCatch:
MsgBox "Search item not found"
'copy record to sheet Entry
ActiveCell.Offset(0, -11).Range("A1:AX1").Select
Selection.Copy
Sheets("Entry").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'delete old record
Search = Range("Search").Value
Sheets("data").Select
Columns("L:L").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(0, -11).Range("A1:AX1").Select
Selection.Delete Shift:=xlUp
Sheets("Entry").Select
End SubGot it!
'Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("data").Select
Columns("M:M").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, -12).Range("A1:AY1").Select
Selection.Copy
Sheets("Entry").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Delete old record
Sheets("data").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub'
Isn't this the same as you posted?
'Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("data").Select
Columns("M:M").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, -12).Range("A1:AY1").Select
Selection.Copy
Sheets("Entry").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Delete old record
Sheets("data").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub'
Isn't this the same as you posted?
Hi, I have a question to your copy to entry code
what I am trying to do is, after a person searches the data based on a string, all the details for that string must be seleted one by one from second sheet and pasted in first sheet D4, D6, D8... ...
I have tried doing this but do not know how to change the range for every iterations( 7th line in the code below)
below is the only code i changed from yours... please help..
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
what I am trying to do is, after a person searches the data based on a string, all the details for that string must be seleted one by one from second sheet and pasted in first sheet D4, D6, D8... ...
I have tried doing this but do not know how to change the range for every iterations( 7th line in the code below)
below is the only code i changed from yours... please help..
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
Hi,
Is this what you are trying to do?
I have moved your B3 selection out of the loop and added an offset:
Sub test()
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("B3").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(1, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
End Sub
Myles
Is this what you are trying to do?
I have moved your B3 selection out of the loop and added an offset:
Sub test()
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("B3").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(1, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
End Sub
Myles
I am sorry its E4 and not E2 and i cahnge my range staring from D4..below is my complete code
Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
Dim i As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Database").Select
Columns("B:B").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("D4").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
'Delete old record
Sheets("Database").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub
Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
Dim i As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Database").Select
Columns("B:B").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("D4").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until ActiveCell.Value = ""
'Delete old record
Sheets("Database").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub
Hi,
Try this. I've added a second loop.
Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
Dim i As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Database").Select
Columns("B:B").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("D4").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until i = 5
'Move to second column
Sheets("Entry").Select
Range("E4").Select
Sheets("Database").Select
i = 1
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until i = 5
'Delete old record
Sheets("Database").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub
Myles
Try this. I've added a second loop.
Sub Search()
Application.ScreenUpdating = False
'Search
Dim Search As String
Dim i As String
On Error GoTo ErrorCatch
Search = Range("Search").Value
Sheets("Database").Select
Columns("B:B").Select
Selection.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
'Copy record to Entry
ActiveCell.Offset(0, 1).Range("A1:A1").Select
i = 1
Sheets("Entry").Select
Range("D4").Select
Sheets("Database").Select
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until i = 5
'Move to second column
Sheets("Entry").Select
Range("E4").Select
Sheets("Database").Select
i = 1
Do
If ActiveCell <> "" Then
Selection.Copy
Sheets("Entry").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveCell.Offset(2, 0).Select
Sheets("Database").Select
i = i + 1
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop Until i = 5
'Delete old record
Sheets("Database").Select
Selection.ClearContents
Sheets("Entry").Select
Exit Sub
ErrorCatch:
Sheets("Entry").Select
MsgBox "Search item not found"
End Sub
Myles
Hi
I have one more question and this will complete my problem...
I have a search cell/box, in the sheet 1 and when a person enters the Emp ID, excel should validate the username which I am already capturing when adding the details to database, if the username is matching with the current user, it must display the all the field back in the sheet 1 from sheet 2 for editing and resubmitting (this is done with code already provided in the thread).
I just need macro for validation as I have it for the whole process.
If it can be done without macro, please provide the solution. The problem witout macro is I need to use a Vlookup along with datavalidation.
but My EMP ID with the current code is captured after the username and Vlookup i think cant work backwards (C to B).
And is there a way to upload a file here.
Below is the update code
-----------------------------
Option Explicit
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "D4,D6,D8,D10,D12,E4,E6"
Set inputWks = Worksheets("Entry")
Set historyWks = Worksheets("Database")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
MsgBox "done"
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
------------------------
I have one more question and this will complete my problem...
I have a search cell/box, in the sheet 1 and when a person enters the Emp ID, excel should validate the username which I am already capturing when adding the details to database, if the username is matching with the current user, it must display the all the field back in the sheet 1 from sheet 2 for editing and resubmitting (this is done with code already provided in the thread).
I just need macro for validation as I have it for the whole process.
If it can be done without macro, please provide the solution. The problem witout macro is I need to use a Vlookup along with datavalidation.
but My EMP ID with the current code is captured after the username and Vlookup i think cant work backwards (C to B).
And is there a way to upload a file here.
Below is the update code
-----------------------------
Option Explicit
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "D4,D6,D8,D10,D12,E4,E6"
Set inputWks = Worksheets("Entry")
Set historyWks = Worksheets("Database")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
MsgBox "done"
End With
'clear input cells that contain constants
With inputWks
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
------------------------
Hey!
I have question on this macros. i have written a macro which pulls the data from share point site and also update the pivot tables links this data. The issue is that this is taking more time like 5-7 mins and also that data sheet is taking much time to scroll to left/right or up/down.
Is there any way to make the macro run fast and also to scroll the data sheet faster?
Thanks,
Dee
I have question on this macros. i have written a macro which pulls the data from share point site and also update the pivot tables links this data. The issue is that this is taking more time like 5-7 mins and also that data sheet is taking much time to scroll to left/right or up/down.
Is there any way to make the macro run fast and also to scroll the data sheet faster?
Thanks,
Dee
Hi,
Are you able to post your code so we can see what it is doing?
It might be worth turning of the screen updating at the start of the macro:
Application.ScreenUpdating = False
and then turn it back on at the end:
Application.ScreenUpdating = TRUE
This way you don't see the screen flickering around.
When you say it is scrolling do you mean that it actually moves cell by cell across the screen? This may be because you recorded the macro? If we can see the code we will be able to see if anything can be cleaned up.
Myles
Are you able to post your code so we can see what it is doing?
It might be worth turning of the screen updating at the start of the macro:
Application.ScreenUpdating = False
and then turn it back on at the end:
Application.ScreenUpdating = TRUE
This way you don't see the screen flickering around.
When you say it is scrolling do you mean that it actually moves cell by cell across the screen? This may be because you recorded the macro? If we can see the code we will be able to see if anything can be cleaned up.
Myles