Search in one workbook and write to another workbook
How do I write the code so it will search "worksheet 1" for the first item in my array, if found, write to validation.xls, then repeat for each instance array item on "worksheet 1". From my testing, i find that it searches "worksheet 1" and when it finds the first instance validation.xls opens and after it writes the first address and value, it starts searching the validation.xls and doesn't switch back to "worksheet 1" to find the next instance.
One thing i need to add is that "worksheet 1" is a variable named workbook sheet. This will always be a single sheet workbook but that sheet name will always be different so i would need to find the name of the workbook and worksheet of the "worksheet 1".
If there are any questions or I am doing anything wrong in what code I have, please feel free to let me know. I am new to vba as you can tell.
Code:
Public Sub ec_es_validation()
Dim MyData As DataObject
Dim myStr As String
Dim myStrArray As Variant
Dim i As Long, x As Long
Dim wBook As Workbook, wBook2 As Workbook
Dim c As Range, Search_Range As Range
Dim nextRow As Variant
Set MyData = New DataObject
MyData.GetFromClipboard
myStr = MyData.GetText(1)
wbOpen = 1
'Does the validation.xls exist?
If Not Dir("C:\Temp\validation.xls", vbDirectory) = vbNullString Then 'yes file exists
'checks to see if the document is open
On Error Resume Next
Set wBook = Workbooks("C:\Temp\validation.xls")
'is file open?
If wBook Is Nothing Then 'Not open
Set wBook = Workbook.Open("C:\Temp\validation.xls")
On Error GoTo 0
End If
Else 'validation.xls does not exist
'creates the validation.xls spreadsheet
Set wBook = Workbooks.Add
With wBook
.Title = "validation"
.SaveAs Filename:="C:\Temp\validation.xls"
End With
End If
nextRow = wBook.Sheets("sheet1").Range("A65535").End(xlUp).Row + 1
nextRow = wBook.Sheets("sheet2").Range("A65535").End(xlUp).Row + 1
myStrArray = Split(myStr, vbNewLine)
nextRow = 1
wBook.Sheets("sheet1").Range("a" & nextRow) = "Address"
wBook.Sheets("sheet1").Range("b" & nextRow) = "Value"
For i = LBound(myStrArray) To UBound(myStrArray)
'myStrArray(i)
With Search_Range
Set c = Cells.Find(What:=myStrArray(i), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
Set Find_Range = c
FirstAddress = c.Address
'FirstColumn = c.Column
Do
Set Find_Range = Union(Find_Range, c)
'write to validation.csv - sheet1 on the next unused cell in column a
wBook.Sheets("sheet1").Range("a" & nextRow) = c.Address
wBook.Sheets("sheet1").Range("b" & nextRow) = c.Value
'wBook.Sheets("sheet1").Range("b" & nextRow) = myStrArray(i)
nextRow = nextRow + 1
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
Else 'clipboard data is not found
wBook.Sheets("sheet2").Range("a" & nextRow) = myStrArray(i)
nextRow = nextRow + 1
'wBook.Sheets("sheet2").Range("b" & nextrow) = c.valuenextrow = nextrow + 1
End If
End With
Next i
clipboard_error:
MsgBox "The clipboard is empty", vbOKOnly
Exit Sub
End Sub
Re: Search in one workbook and write to another workbook
Quote:
nextRow = wBook.Sheets("sheet1").Range("A65535").End(xlUp).Row + 1
nextRow = wBook.Sheets("sheet2").Range("A65535").End(xlUp).Row + 1
the second overwrites the first, which do you want?
i don't see anywhere search range is declared or set, do you get error on that? or is search range set elsewhere?
you can set the source sheet to an object
vb Code:
set srcsht = workbooks("bookname.xls").sheets(1)
first sheet in book
you should then be able to prefix all srcsheet to your find
vb Code:
set search_range = srcsht.range("a1:h8")
change names and ranges to suit, should then work with existing code
