Using 2 Finds, for 2 Different Sheets, Then Copy/Pasting A Found Row's Data to Other Found Row

[VBAExpertNot]

Hello,

Conceptually, I'm thinking I should be able to do this, but I'm stuck one line of code.

Background: File has 2 sheets. Each sheet, in its column A, has different categories which are string dimensions/values. But each sheet often has the same string value, such as "Ajax", in my code example.

I thought I could do a separate Find for each sheet, and then store each value for later use.

However, when I want to copy a row of data (about 31 columns of numbers) from one sheet to the other that does not have the data, my code gets stuck. It gets stuck on that one line of code.

This is my first use of Find, so I could be easily missing a nuance in the code.

Any feedback or help would be much appreciated.

code

Sub FindStr()

Dim rFndCell As Range
Dim rFndCell2 As Range
Dim strData As String
Dim stFnd As String

Dim fRow As Integer
Dim sh As Worksheet
Dim ws As Worksheet


Set ws = Sheets("OriginalStats")
Set sh = Sheets("TargetTab")
stFnd = "Ajax"



With sh


Set rFndCell = .Range("A:A").Find(stFnd, LookIn:=xlValues)
If Not rFndCell Is Nothing Then
fRow = rFndCell.Row

Else 'Can't find the item
MsgBox "No Find"


End If
End With


With ws
Set rFndCell2 = .Range("A:A").Find(stFnd, LookIn:=xlValues)
If Not rFndCell2 Is Nothing Then
fRow2 = rFndCell2.Row
ws.Range(fRow2, 1).Offset(0, 5).Resize(0, 31).Copy Destination:=sh(fRow, 5).Offset(1, 0)


Else 'Can't find the item
MsgBox "No Find"

End If
End With


End Sub
/code

 

[wideboydixon]

You'll try and copy the data even if the text isn't found on TargetTab. You need to cancel the copy if it's not found:

Sub FindStr()

Dim rFndCell As Range
Dim rFndCell2 As Range
Dim strData As String
Dim stFnd As String

Dim fRow As Integer
Dim sh As Worksheet
Dim ws As Worksheet

Set ws = Sheets("OriginalStats")
Set sh = Sheets("TargetTab")
stFnd = "Ajax"

With sh
    Set rFndCell = .Range("A:A").Find(stFnd, LookIn:=xlValues)
    If Not rFndCell Is Nothing Then
        fRow = rFndCell.Row
    Else
        fRow = 0
        MsgBox "Not found on TargetTab"
    End If
End With

With ws
    Set rFndCell2 = .Range("A:A").Find(stFnd, LookIn:=xlValues)
    If Not rFndCell2 Is Nothing Then
        fRow2 = rFndCell2.Row
        If fRow > 0 Then
            ws.Range(fRow2, 1).Offset(0, 5).Resize(0, 31).Copy Destination:=sh(fRow, 5).Offset(1, 0)
        End If
    Else
        MsgBox "Not found on OriginalStats"
    End If
End With

End Sub

WBD

 

[hiker95]

VBAExpertNot,

Welcome to the MrExcel forum.


We would like more information. Please see the Forum Use Guidelines in the following link:

http://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html


See reply #2 at the next link, if you want to show small screenshots, of the raw data worksheets, and, what the results should look like.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729


If you are not able to provide screenshots, then:

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

 

[VBAExpertNot]

You'll try and copy the data even if the text isn't found on TargetTab. You need to cancel the copy if it's not found:

Sub FindStr()

Dim rFndCell As Range
Dim rFndCell2 As Range
Dim strData As String
Dim stFnd As String

Dim fRow As Integer
Dim sh As Worksheet
Dim ws As Worksheet

Set ws = Sheets("OriginalStats")
Set sh = Sheets("TargetTab")
stFnd = "Ajax"

With sh
    Set rFndCell = .Range("A:A").Find(stFnd, LookIn:=xlValues)
    If Not rFndCell Is Nothing Then
        fRow = rFndCell.Row
    Else
        fRow = 0
        MsgBox "Not found on TargetTab"
    End If
End With

With ws
    Set rFndCell2 = .Range("A:A").Find(stFnd, LookIn:=xlValues)
    If Not rFndCell2 Is Nothing Then
        fRow2 = rFndCell2.Row
        If fRow > 0 Then
            ws.Range(fRow2, 1).Offset(0, 5).Resize(0, 31).Copy Destination:=sh(fRow, 5).Offset(1, 0)
        End If
    Else
        MsgBox "Not found on OriginalStats"
    End If
End With

End Sub

WBD

Thank you WBD, code works great! Note, when copying, I should use Cells, not Range, in the code.

 

[mikerickson]

Actualy, you could avoid the fRow variable entirely.

rFindCell2.EntireRow.Range("F1").Resize(1, 31).Copy Destination:=rFindCell.EntireRow.Range("E1")

The 0 in .Resize(0,31) was one of the problems with the OP line.