Find And Replace - Excel 2007 - VBA

[rabbit001]

Its a find and replace macro between two workbooks.

I have 2 ploblems:

1 - I cant fill any text in range A3:A in Sheet1, otherwise i get runtime error 13
2 - The code is only working for row 3-4 in Sheet1
And row 2-3 in Sheet2, and i have over 1300 rows in my original files.

Can anybody help me fixing this?

Here is my code:

Private Sub CommandButton1_Click()
    Dim Sheet1lastRow As Long, Sheet2lastRow As Long
    Dim i As Long
    Dim FileName1 As String, FileName2 As String, srchString As String
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim aCell As Range
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    '~~> Change File Names Here
    FileName1 = "C:\Users\xxx\Desktop\Sheet1.csv"
    FileName2 = "C:\Users\xxx\Desktop\Sheet2.csv"
 
    Set Wb1 = Workbooks.Open(Filename:=FileName1)
 
    Wb1.Sheets(1).Columns("A:A").TextToColumns Destination:=Wb1.Sheets(1).Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
 
    Sheet1lastRow = Wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
 
    Set Wb2 = Workbooks.Open(Filename:=FileName2)
 
    Wb2.Sheets(1).Columns("A:A").TextToColumns Destination:=Wb2.Sheets(1).Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1)), TrailingMinusNumbers:=True
 
    Sheet2lastRow = Wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
 
    For i = 3 To Wb1.Sheets(1).Range("F3:F" & Sheet1lastRow)
        srchString = Wb1.Sheets(1).Range("F" & i)
 
        Set aCell = Wb2.Sheets(1).Range("A2:A" & Sheet1lastRow).Find(What:=srchString, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
 
        If Not aCell Is Nothing Then
            If aCell.Offset(, 2).Value <> Wb1.Sheets(1).Range("E" & i) Then
                aCell.Offset(, 2).Value = Wb1.Sheets(1).Range("E" & i)
            End If
        End If
    Next
 
    Wb1.Close savechanges:=False
    Wb2.Close savechanges:=True
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Thanks
Rob

[stanleydgrom]

rabbit001,


For a start, change this:

[VBA]

Sheet2lastRow = Wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1

[/VBA]


To this:

[VBA]

Sheet2lastRow = Wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1


[/VBA]

[omnibuster]

Try this

[VBA]Private Sub CommandButton1_Click()
Dim Sheet1lastRow As Long, Sheet2lastRow As Long
Dim i As Long
Dim FileName1 As String, FileName2 As String, srchString As String
Dim Wb1 As Workbook, Wb2 As Workbook
Dim aCell As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'~~> Change File Names Here
FileName1 = "C:\Users\xxx\Desktop\Sheet1.csv"
FileName2 = "C:\Users\xxx\Desktop\Sheet2.csv"

Set Wb1 = Workbooks.Open(Filename:=FileName1)
Stop
Wb1.Sheets(1).Columns("A:A").TextToColumns Destination:=Wb1.Sheets(1).Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True

Sheet1lastRow = Wb1.Sheets(1).Range("F" & Rows.Count).End(xlUp).Row

Set Wb2 = Workbooks.Open(Filename:=FileName2)

Wb2.Sheets(1).Columns("A:A").TextToColumns Destination:=Wb2.Sheets(1).Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1)), TrailingMinusNumbers:=True

Sheet2lastRow = Wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row - 1

For i = 3 To Sheet1lastRow
srchString = Wb1.Sheets(1).Range("F" & i)

Set aCell = Wb2.Sheets(1).Range("A2:A" & Sheet1lastRow).Find(What:=srchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
If aCell.Offset(, 2).Value <> Wb1.Sheets(1).Range("E" & i) Then
aCell.Offset(, 2).Value = Wb1.Sheets(1).Range("E" & i)
End If
End If
Next
Wb1.Close savechanges:=False
Wb2.Close savechanges:=True

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
[/VBA]