Code does not error but no copy either

[Howard]

Code does not work and does not error.

Find a value in the Sheets("Sheet1").Range("A1:H11") and copy the values in columns I and K of the "found string" row to Workbooks("Book2").Sheets("Sheet1") Range("B15") and Range("D15") with next copies below the last.

Also, I know there is a cleaner way than the .Range("B100").End(xlUp).Offset(1, 0)
but I cannot find one in my archives.

Thanks,
Howard

Option Explicit

Sub Find_First()
Dim FindString As String
Dim Rng As Range
Dim i As Long
Dim RngI As String
Dim RngK As String

FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A1:H11")
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
i = Rng.Column

RngI = ActiveCell.Offset(0, 9 - i)
RngK = ActiveCell.Offset(0, 11 - i)

Workbooks("Book2").Sheets("Sheet1").Range("B100").End(xlUp).Offset(1, 0) = RngI
Workbooks("Book2").Sheets("Sheet1").Range("D100").End(xlUp).Offset(1, 0) = RngK

Else
MsgBox "Nothing found"
End If

End With

End If

End Sub

 

[Claus Busch]

Hi Howard,

Am Mon, 15 Jul 2013 23:53:19 -0700 (PDT) schrieb Howard:

Code does not work and does not error.

Find a value in the Sheets("Sheet1").Range("A1:H11") and copy the values in columns I and K of the "found string" row to Workbooks("Book2").Sheets("Sheet1") Range("B15") and Range("D15") with next copies below the last.

Also, I know there is a cleaner way than the .Range("B100").End(xlUp).Offset(1, 0)
but I cannot find one in my archives.

try:

If Not Rng Is Nothing Then
RngI = .Cells(Rng.Row, "I")
RngK = .Cells(Rng.Row, "K")
With Workbooks("Book2").Sheets("Sheet1")
Set LRow = .Cells(.Rows.Count, "B").End(xlUp)(2)
LRow = RngI
LRow.Offset(, 2) = RngK
End With
Else
MsgBox "Nothing found"
End If


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Mon, 15 Jul 2013 23:53:19 -0700 (PDT) schrieb Howard:







try:



If Not Rng Is Nothing Then

RngI = .Cells(Rng.Row, "I")

RngK = .Cells(Rng.Row, "K")

With Workbooks("Book2").Sheets("Sheet1")

Set LRow = .Cells(.Rows.Count, "B").End(xlUp)(2)

LRow = RngI

LRow.Offset(, 2) = RngK

End With

Else

MsgBox "Nothing found"

End If





Regards

Claus B.

Much cleaner.
Thanks, Claus.

Regards,
Howard

 

[Claus Busch]

Hi Howard,

Am Tue, 16 Jul 2013 00:59:33 -0700 (PDT) schrieb Howard:

Much cleaner.

but does it work?


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Tue, 16 Jul 2013 00:59:33 -0700 (PDT) schrieb Howard:






but does it work?





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Yes, indeed, works fine. However, it had a subscript out of range error and that lead me to investigate and see that my original code was actually working except I have Book2 as the copy TO and It should have been Book3.

So it would copy back to the same sheet as the copy FROM, while all the time I was looking at book3 for the results and not getting any.

You can fix code, but you can't fix stupid.<g>

Thanks Claus.

Regards,
Howard