Help With VBA

[bestman21]

Hi,


Please check the below code I need to change reading source from Sheets("Data")

to external workbook located in C:Data.xlsx

Also this MsgBox "Search item not found" always showing to me even data copied well.


Sub test1()

Application.ScreenUpdating = False

'Search

Dim Search As String

Dim i As String


On Error GoTo ErrorCatch

Search = Range("A1").Value


Sheets("Data").Select

Columns("A:E").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:E1").Select

i = 1


Sheets("Entry").Select

Range("D4").Select

Sheets("Data").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("Data").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("Data").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("Data").Select

Selection.ClearContents

Sheets("Entry").Select


Exit Sub


ErrorCatch:

Sheets("Entry").Select

MsgBox "Search item not found"


End Sub

 

[Luke M]

I think the line

[pre]

Sheets("Database").Select
is the problem, since you were working w/ sheet "Data". To help make it easier to catch problems, I'd suggest changing the first bit of code to look like this:

On Error GoTo ErrorCatch
Selection.Find(What:="a", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
On Error GoTo 0

[/pre]
That way you only get the error message if there is truly no record found, and not for when other compiling errors occur.


As for opening the other file and copying to it, you'll need to do something like:

Application.Workbooks.Open ("C:Data.xlsx")

at the beginning, and then rewrite several lines of code to handle switching back and forth between the two workbooks. Might be easiest for you to record yourself doing it the first time to get the basics.

 

[bestman21]

I try it but not worked with me

If you can help me to write this several lines,

Appreciate your reply.

 

[bestman21]

Luke M


IS this correct


Sub test1()

Application.ScreenUpdating = False

'Search

Dim Search As String

Dim i As String

Dim WBTHIS As Workbook

Set WBTHIS = ThisWorkbook


Search = Range("A1").Value

Workbooks.Open Filename:="C:Data.xlsx"

Sheets("Data").Select

Columns("A:E").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:D1").Select

i = 1

WBTHIS.Activate

Sheets("Entry").Select

Range("D4").Select

Workbooks.Open Filename:="c:Data.xlsx"

Sheets("Data").Select


If ActiveCell <> "" Then

Selection.Copy

WBTHIS.Activate

Sheets("Entry").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=True


ActiveCell.Offset(2, 0).Select

Workbooks.Open Filename:="c:Data.xlsx"

Sheets("Data").Select


i = i + 1

ActiveCell.Offset(2, 0).Select


End If


'Move to second column

WBTHIS.Activate

Sheets("Entry").Select

Range("E4").Select

Workbooks.Open Filename:="c:Data.xlsx"

Sheets("Data").Select


i = 1


Do

If ActiveCell <> "" Then

Selection.Copy

Sheets("Data").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("Data").Select

Selection.ClearContents

Sheets("Entry").Select


Exit Sub


ErrorCatch:

Sheets("Entry").Select

Workbooks("WBTHIS").Activate

MsgBox "Search item not found"


End Sub

 

[Luke M]

Close. You don't really want to "open" the other workbook so many times, you just need to reactivate it. After opening the Data.xlsx workbook the first time, you could do something like:

[pre]

Dim WBTHAT as Workbook
Set WBTHAT = ActiveWorkbook
And then replace any following Open command with:

[pre][code]WBTHAT.Activate

[/pre]
You've got an extra set of i=1 and i=i+1 commands early on in your code. Doesn't cause problems, but there's no need for it. Also, looking at your error catch, the activate line is incorrect. Should just be:

WBTHIS.Activate[/code][/pre]