Important alert: (current site time 7/31/2014 3:17:47 PM EDT)
 

VB icon

search data place adjacent

Email
Submitted on: 6/19/2012 5:14:43 PM
By: Oruc Kenan Yildirim  
Level: Advanced
User Rating: By 2 Users
Compatibility: VB 5.0, VB 6.0, VBA MS Excel
Views: 2097
(About the author)
 
     This code is working with the following steps: Values used: first array is composedof words to search words. The name of array is searchArray second array is composed of the words that are related to search words. This array`s name is responsearray. the first and second array connection is made by an integer number arrayno. This number is used to make connection with the array inhibited numbering. This lets the coding being dynamic. How it works: The code is using arrayno to make a search of predefined words, then it gives in adjacent column the result words. By using looping I can make this search of string and place in adjacent column the result string many times I want in a list of data. Tips: place your data in column D or E in Excel , it needs to have 3 empty columns on the left of data. This is not yet perfect, I need to improve one part so as it stops looping when it reaches the end of data, this will be on version 2.0 Please tell me if you like it.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
  1. You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.
				
'**************************************
' Name: search data place adjacent 
' Description:This code is working with the following steps:
Values used:
first array is composedof words to search words. The name of array is searchArray
second array is composed of the words that are related to search words. This array`s name is responsearray.
the first and second array connection is made by an integer number arrayno. This number is used to make connection with the array inhibited numbering. This lets the coding being dynamic.
How it works:
The code is using arrayno to make a search of predefined words, then it gives in adjacent column the result words. 
By using looping I can make this search of string and place in adjacent column the result string many times I want in a list of data.
Tips: place your data in column D or E in Excel , it needs to have 3 empty columns on the left of data.
This is not yet perfect, I need to improve one part so as it stops looping when it reaches the end of data, this will be on version 2.0
Please tell me if you like it.
' By: Oruc Kenan Yildirim
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=74400&lngWId=1'for details.'**************************************

Sub searchplaceadjacent()
'*****************************************************
'*****************************************************
'************code by Oruc Kenan Yildirim *************
'*********** search data place adjacent **************
'************version 1.0 *************
'************ oruc@outsideuniverse.com*************
'************ www.outsideuniverse.com*************
'*****************************************************
'*****************************************************
Dim searchArray() As Variant
Dim responsearray() As Variant
Dim arrayno As Integer
 'create array from list of comma separated strings
searchArray = Array("fin fan", "yahoo", "wendy")
responsearray = Array("cooler", "website", "dunes")
'search each array -- note there are three content here to search for
For firstloopsearchstring = 1 To 3
'first array`s number is zero, but firstloopsearchstring has a value of 1, so I need to substract 1
arrayno = firstloopsearchstring - 1
'find the array corresponding value
Cells.Find(What:=searchArray(arrayno), After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'make this search 100 times in a list - this part is very weak I know I need to improve it
For seconddataloop = 1 To 100
'MOVING TO CELL
'********
'note here in the same row many of the search values could be there in the same time
' instead of overwriting it moves to another column and writes response value in there
'********
Row = 0
clms = (firstloopsearchstring) * (-1)
ActiveCell.Offset(Row, clms).Select
'if adjacent activecell content is empty then write corresponding responsearray
If ActiveCell = "" Then
ActiveCell.FormulaR1C1 = responsearray(arrayno)
'MOVING TO CELL**return back
Row = 0
clms = firstloopsearchstring
ActiveCell.Offset(Row, clms).Select
'find next
Cells.FindNext(After:=ActiveCell).Activate
Else
' if activecell content is
'find next
 Cells.FindNext(After:=ActiveCell).Activate
End If
Next seconddataloop
Next firstloopsearchstring
End Sub


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.