3
\$\begingroup\$

I want to search for a string inserted in TextBox1 on Mainwb 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)

I am totally new to VBA and wrote this code quoting from many sources. I'd like to know how it can be improved.

This is used to search within the same workbook:

Sub CommandButton1_Click()
Dim wb1 As Workbook, Wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strSearch As String
Dim f As Variant
Dim fAddress As String
Dim fRow As Long
Dim cellA As Variant
Dim cellB As Variant


 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 ws2 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")
   Set ws1 = Wb2.Worksheets("DATA")  

strSearch = TextBox1.Value

ws1.Range("A5:G2000").ClearContents
Set dmr = Workbooks.Open("C:\Users\aselhayani\Desktop\Excel Reports\OfficerA.xlsx")
Set dmr = Worksheets("DATA")
strSearch = InputBox("Please enter T24 ID:", "Search Value")

pasteRowIndex = 5

If strSearch = vbNullString Then
    MsgBox ("User canceled, or did not enter a value.")
    Exit Sub
End If

With ws1.Range("A2:G2000")

    Set f = .Find(strSearch, LookIn:=xlValues)
    If Not f Is Nothing Then
        fAddress = f.Address
        Do
            fRow = f.Row
            cellA = ws2.Cells(fRow, 1).Value
            cellB = ws2.Cells(fRow, 2).Value
            cellC = ws2.Cells(fRow, 3).Value
            cellD = ws2.Cells(fRow, 4).Value
            cellE = ws2.Cells(fRow, 5).Value
            cellF = ws2.Cells(fRow, 6).Value
            cellG = ws2.Cells(fRow, 7).Value

            ws1.Cells(pasteRowIndex, 1) = cellA
            ws1.Cells(pasteRowIndex, 2) = cellB
            ws1.Cells(pasteRowIndex, 3) = cellC
            ws1.Cells(pasteRowIndex, 4) = cellD
            ws1.Cells(pasteRowIndex, 5) = cellE
            ws1.Cells(pasteRowIndex, 6) = cellF
            ws1.Cells(pasteRowIndex, 7) = cellG

            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
\$\endgroup\$
5
  • 1
    \$\begingroup\$ This code appears to be broken - the description says it is searching for the value from TextBox1.Value, but that value is never used - it's overwritten on the line strSearch = InputBox("Please enter T24 ID:", "Search Value"). \$\endgroup\$
    – Comintern
    Commented Aug 12, 2016 at 0:25
  • 1
    \$\begingroup\$ @Comintern IMO, that seems like an overly harsh interpretation, considering the code does actually "work" and the OP is quite obviously a beginner here. Would be better to clarify which value they want to search for and/or why they're asking for it in 2 different places. \$\endgroup\$
    – Kaz
    Commented Aug 12, 2016 at 10:21
  • \$\begingroup\$ totally agree I am new in coding :) . I am searching for client number and I am asking for it in 2 or more different workbooks cause Client might be served or linked to client which served by one employee and each employee extract his reports into separate excel sheets \$\endgroup\$ Commented Aug 12, 2016 at 10:57
  • \$\begingroup\$ Welcome to Code Review! It looks like you have a good question here. Did you come from another language or did you learn by using the macro recorder? \$\endgroup\$ Commented Aug 12, 2016 at 17:51
  • \$\begingroup\$ No totally new to coding and learning from this site and YouTube \$\endgroup\$ Commented Aug 12, 2016 at 17:54

2 Answers 2

3
\$\begingroup\$

Variables

Good job is making sure to declare all variables with a type:

 Dim wb1 As Workbook, Wb2 As Workbook

However, there's no real reason to group your variables like that; as you see with your strings it would get too long.

More on variables - give them some meaningful names. And avoid that hungarian naming:

Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim searchValue As String
Dim foundAddress As String
Dim foundRow As Long
Dim searchArray As Variant

Oh no, you didn't declare these variables:

  cellA = ws2.Cells(fRow, 1).Value
  cellB = ws2.Cells(fRow, 2).Value
  cellC = ws2.Cells(fRow, 3).Value
  cellD = ws2.Cells(fRow, 4).Value
  cellE = ws2.Cells(fRow, 5).Value
  cellF = ws2.Cells(fRow, 6).Value
  cellG = ws2.Cells(fRow, 7).Value

Why not use a range or an array? Seems like it will always be columns 1:7. Something like

For Each f In searchRange 'or your specific range
    Set f = searchRange.Find(searchValue, LookIn:=xlValues)
    If Not f Is Nothing And f.Address <> fAddress Then
        ws1.Range(Cells(pasterowindex, 1), (Cells(pasterowindex, 7))) = ws2.Range(Cells(fRow, 1), (Cells(fRow, 7)))
    End If
Next

But with better variables. I also dislike Do loops and stick to For Each loops, but that's my preference. It also can avoid the With block - you're nesting too many things, I think.

You also missed declaring these: dmr, pasteRowIndex

But I don't see you ever actually using dmr?

When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Additionally, I have no way of telling what dmr is. Plus first it's a workbook and then it's a range - the only reason it's working is because you didn't declare it and it's inherently a variant. Get two variables with good names in there!

Plus, what's this?

dim ws2 as worksheet
Set ws2 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")

Setting a worksheet variable to a range? Also why does ws2 reference wb1 and vice-versa? I got really confused on what the source and target actually are.


Praise


Misc

When you do this

 ws1.Range("A5:G2000").ClearContents

You already gave the book and sheet a variable, just give this a range variable - it will make the code look cleaner. Additionally if you're using 2000 because you don't know how big the range is, there is a standard way to find lastRow and lastColumn. That post explains why.

What is this spacing about -

 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 ws2 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")
   Set ws1 = Wb2.Worksheets("DATA")

Be sure you align your levels:

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 ws2 = wb1.Sheets("MAIN SCREEN").Range("A5:G2000")
Set ws1 = Wb2.Worksheets("DATA")

Also, what happens if the book isn't found or the sheet doesn't exist? Handle those errors!

Same goes for a space in the inputbox - " " <> vbNullString

Also why are you doing this -

strSearch = TextBox1.Value
...
strSearch = InputBox("Please enter T24 ID:", "Search Value")

I don't see that TextBox1 ever being used.


My version

Would look something like this -

Option Explicit

Sub CommandButton1_Click()

Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim sourceRange As Range
Dim targetRange As Range
Dim searchCell As Range
Dim searchValue As String
Dim targetRow As Long
targetRow = 5
Dim lastRow As Long

On Error GoTo ErrHandler

Set sourceWorkbook = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\OfficerA.xlsx")
Set sourceSheet = sourceWorkbook.Worksheets("DATA")
lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set sourceRange = sourceSheet.Range("A5:G" & lastRow)

Set targetWorkbook = Workbooks.Open("C:\Users\elhayani\Desktop\development\AML db\Mainwb.xlsm")
Set targetSheet = targetWorkbook.Sheets("MAIN SCREEN")
Set targetRange = targetSheet.Range("A5:G" & lastRow)
targetRange.ClearContents

searchValue = InputBox("Please enter T24 ID:", "Search Value")
If searchValue = vbNullString Or searchValue = " " Then Exit Sub

For Each searchCell In sourceRange 'or your specific range
    Set searchCell = sourceRange.Find(searchValue, LookIn:=xlValues)
    If Not searchCell Is Nothing Then
        targetSheet.Range(Cells(targetRow, 1), (Cells(targetRow, 7))) = sourceSheet.Range(Cells(searchCell.Row, 1), (Cells(searchCell.Row, 7)))
        targetRow = targetRow + 1
    End If
Next
Exit Sub

ErrHandler:
    MsgBox "WHOOPS"

End Sub

Advanced

Your way of doing the loop to .Find the search value is pretty complicated considering you can just .FindNext and avoid the loop altogether, but I know that's a lot to take in right now.

\$\endgroup\$
2
\$\begingroup\$

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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.