PDA

View Full Version : Find And Replace - Excel 2007 - VBA



rabbit001
11-25-2010, 08:24 AM
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
11-27-2010, 05:43 AM
rabbit001,


For a start, change this:



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




To this:



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

omnibuster
12-04-2010, 09:52 AM
Try this

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