I'm starting from an excerpt of your written specifications:
"I want to search for a string ... within a range of data located in Workbook officerA Worksheet DATA!(A2,G2000), and then paste results found into Workbook Mainwb.sheet("MAIN SCREEN").Range (A5,G500)"
to which I'm adding:
what can be derived from part of your code:
"Previous results in "MAIN SCREEN" (from row 5 downwards) must be erased"
what I guess it could (or should?) be:
"search must be made in column "A" of "DATA" worksheet"
With all what above stated, let's start:
Range reference errors
in your With ws1.Range("A2:G2000")
block you're:
looking for strSearch
in ws1
, i.e. in "DATA" worksheet of "OfficerA" workbook, with:
Set f = .Find(strSearch, LookIn:=xlValues)
and that's OK with specifications
writing ws2
data into ws1
worksheet, with all those:
cellA = ws2.Cells(fRow, 1).Value
...
ws1.Cells(pasteRowIndex, 1) = cellA
i.e. you're writing "MAIN SCREEN" worksheet of "Mainwb" workbook data into "DATA" worksheet of "OfficerA" workbook
and that's NOT OK since specifications says the opposite:
"paste results found into Workbook Mainwb.sheet("MAIN SCREEN").Range (A5,G500)"
using fRow
as the row index for source cells in ws2
fRow = f.Row
cellA = ws2.Cells(fRow, 1).Value
'<-- fRow
is used as row index of Cells
object in ws2
which once again is NOT OK, since fRow
is the index of the found cell in ws1
, and has therefore no logic connection with ws2
Determination of a worksheet last non empty row
your ws2.Range("A5:G2000").ClearContents
seems much a hard coded way to embrace a sufficiently wide range where previous data could reside and delete them
but things can grow beyond initial expectations and cause problems
furthermore acting on a wider range than the actually necessary one could arise performance issues
so it should always be determined the actual extension of the wanted range
this can be done in different ways, depending on your data structure
for instance should all "DATA" worksheet be cleared, than you could use
ws2.UsedRange.ClearContents
which would clear the content of all cells between the most up-left used cell and the most bottom-right one. (here, the used term has a very wide meaning: check for it in msdn documentation)
or, should all cells belonging to a well defined column range be cleared, then you could use
Intersect(ws2.UsedRange, ws2.Columns("A:G").ClearContents
where you act on the Range
resulting from the intersection of the ws2
wanted columns and its UsedRange
(determined as above explained)
still, there could be the need to act on cells belonging to certain columns but not above a specific row (like your case could seem to be)
in this case a good coding habit of doing this is the following:
With ws '<--| reference a worksheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<--| get referenced worksheet last non emtpt cell row in its column "A"
If lastRow > 4 Then .Range("A5:G" & lastRow).ClearContents '<-- clear columns A:G cells from row 5 down to column "A" last non empty one
End With
here it's assumed that column "A" is the counter one, i.e. any "non empty" row has at least column A cell filled with some value
Find()
method has "memory"
When using Find() method you'd better always explicitly specify its LookIn
, LookAt
, SearchOrder
, and MatchByte
parameters. should they be not specified then settings from its last call (even form Excel UI one!) would be used.
So you want to use:
Set f = .Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
Moreover your actual searching range is Range("A2:G2000")
, which means all cells from row 2 to 2000 in columns A to G, while it's quite probable you want to look in one column only
I'll assume column "A" a the searching one
Pasting Values
you're writing unnecessary code lines, since every single couple of statements:
cellA = ws2.Cells(fRow, 1).Value
...
ws1.Cells(pasteRowIndex, 1) = cellA
can be shortened down to:
ws1.Cells(pasteRowIndex, 1).Value = ws2.Cells(fRow, 1).Value
but you can have them all shortened down to a single statement like:
Range1.Value = Range2.Value
provided both ranges have the same size, which in your case could be achieved as follows:
ws2.Cells(pasteRowIndex, 1).Resize(, 7).Value = ws1.Cells(fRow, 1).Resize(, 7).Value
with both ws1
and ws2
defined as per your original code (i.e. not yet swapped for what above discussed in "Variable names consistency" section)
Miscellanea
put any exit condition at the top of your module, to avoid unnecessary execution of code lines
Sub CommandButton1_Click()
Dim strSearch As String
strSearch = TextBox1.Value
If strSearch = vbNullString Then
MsgBox ("User canceled, or did not enter a value.")
Exit Sub
End If
'... rest of the code
Variable names consistency
you can adopt whatever naming convention you may want, but you must be consistent with it throughout your code so as to make your code more readable and thus more debuggable and finally more maintainable.
that's why since "MAIN SCREEN" is a wb1
workbook worksheet, you should set it to some ws1
worksheet variable instead of ws2
to which should be set any worksheet belonging to wb2
workbook instead:
Set ws1 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")
Set ws2 = Wb2.Worksheets("DATA")
SUMMARY #1
for all what above your code could become the following:
Sub CommandButton1_Click()
Dim strSearch As String
strSearch = TextBox1.Value
If strSearch = vbNullString Then
MsgBox ("User canceled, or did not enter a value.")
Exit Sub
End If
Dim wb1 As Workbook, wb2 As Workbook
Dim ws2 As Worksheet, ws1 As Worksheet
Dim f As Range
Dim fAddress As String, lastRow As Long, fRow As Long, pasteRowIndex As Long
Set Wb2 = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\OfficerA.xlsx")
Set wb1 = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm")
Set ws1 = wb1.Worksheets("MAIN SCREEN")
Set ws2 = wb2.Worksheets("DATA")
With ws1 '<--| reference "destination" worksheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<--| get reference worksheet last non emtpty cell row in its column "A"
If lastRow > 4 Then .Range("A5:G" & lastRow).ClearContents '<-- clear only cells from row 5 down to colmun "A" last non empty one
End With
With ws2 '<--| reference "source" worksheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<--| get reference worksheet last non emtpty cell row in its column "A"
End With
pasteRowIndex = 5
With ws2.Range("A2:A" & lastRow) '<--| reference "searching" column in "source" worksheet
Set f = .Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
fAddress = f.Address
Do
fRow = f.Row
ws1.Cells(pasteRowIndex, 1).Resize(, 7).Value = ws2.Cells(fRow, 1).Resize(, 7).Value
pasteRowIndex = pasteRowIndex + 1
Set f = .FindNext(f)
Loop While Not f Is Nothing And f.Address <> fAddress
End If
End With
MsgBox "Search Done"
End Sub
BOOST IT UP!
but you can both shorten your code and speed it up by exploiting the following features
Autofilter
Autofilter method of Range
object allows for selection of multiple rows out of a range by filtering on given columns matches
for instance, with:
With ws1
With .Range("A1:G" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.AutoFilter field:=1, Criteria1:=TextBox1.Value
you first reference a ws1
worksheet range delimited by columns A to G and row 1 to column "A" last non empty cell row, and then filter it on its first column to match TextBox1.Value
after it you either get filtered cells or not, so which you may check for it as follows:
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
where you count the number of visible cells of first columns and ask them to be greater than one since the header one gets always filtered
should any cells be filtered then you can reference them all in one shot by use of SpecialCells
method of Range
object, specifying xlCellTypeVisible
as its Type
parameter
rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
where once again you skip header cells by means of Offset()
and Resize()
methods of Range
object
**Use With...End With
to decrease variables number **
finally you can avoid the use of many variables by means of With ... End With
blocks in a proper order
for instance:
With Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm").Sheets("MAIN SCREEN")
allows for both the opening the specified workbook and referencing its "MAIN SCREEN" worksheet
SUMMARY #2
a possible resulting final code can be the following:
Sub CommandButton1_Click()
Dim lastRow As Long
Dim destRng As Range
If Me.TextBox1.Value = vbNullString Then
MsgBox ("please enter a value")
Exit Sub
End If
With Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm").Sheets("MAIN SCREEN") '<-- open "destination" workbook and reference its "MAIN SCREEN" worksheet
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row '<--| evaluate its column "A" last non empty cell row
If lastRow > 4 Then .Range("A5:G" & lastRow).ClearContents '<--| clear possible old data from row 5 downwards
Set destRng = .Range("A5:G5") '<--| set the "destination" range
End With
With Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm").Worksheets("DATA") '<--| '<-- open "source" workbook and reference its "DATA" worksheet
With .Range("A1:G" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| reference its range in columns A:G from row 1 to column "A" last non empty cell row
.AutoFilter field:=1, Criteria1:=TextBox1.Value '<--| filter range on its 1st column with TextBoxx value
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered...
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destRng '<--|...copy all filtered values (skipping headers) to destination range
End If
.Parent.AutoFilterMode = False '<--| show all rows back
End With
End With
MsgBox "Search Done"
End Sub
TextBox1.Value
, but that value is never used - it's overwritten on the linestrSearch = InputBox("Please enter T24 ID:", "Search Value")
. \$\endgroup\$