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
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