PDA

View Full Version : Lookup text if match found, paste it into the next cell



karthikin
12-16-2011, 08:18 AM
In CVS file, In the col C full of information about application softwares like Windows XP, Adobe, Office, .net Framework, vlc, etc.... So, in the col C i have around >1800 lines.

I want to look for Windows XP,Adobe, IBM, VLC etc in each & every col cell or in the entire col if there a match then paste the match value in the next column cell.
For example, if "Adobe" found then paste "Adobe" to the next col cell.

How can i perform using ìf or Lookup or is there any best way??

if(FIND("Adobe",C:C),"TRUE","FALSE")

=Lookup(Windows XP, C:C) would return "Windows XP" =Lookup(Adobe, C:C) would return "Adobe" =Lookup(IBM, C:C) would return "IBM "

I have uploaded the CVS file here!!


http://uploadmb.com/freeuploadservice.php?uploadmbID=1324042163&srv=www&filename=5200.csv

Bob Phillips
12-16-2011, 09:53 AM
Lookup Range.Findnext in VBA help, there is a complete example there.

karthikin
12-16-2011, 01:38 PM
@xld: can u please give me an example??

For example, if "Adobe" found then paste "Adobe" to the next col cell.
if "Windows XP" found then paste "Windows XP" to the next col cell.

Bob Phillips
12-17-2011, 04:29 AM
Did you look in help, the example is there?

karthikin
12-17-2011, 05:59 AM
@xld: could you please tell me where is the help for Lookup Range.Findnext in VBA????

shrivallabha
12-17-2011, 08:58 AM
If there are few items (maybe 10) to check then you can also use AutoFilter for this purpose.

Apply filter to this range and then use "contains" option to search entries matching criteria one by one!

karthikin
12-17-2011, 09:15 AM
@shrivallabha: Correctif pour Windows XP (KB961118)
Mise Ã* jour de sécurité pour Windows XP (KB956744)
Avenue Single User
IBM iSeries Access for Windows
Graphics Base
Désinstallation du logiciel d''imprimante IBM
IBM Software Delivery Center Client and Agent
Correctif Windows XP - KB867282
Correctif Windows XP - KB873333

I have these lines in Col C around 1800 lines so i want to look for some data for example, Windows XP, IBM, Adobe,VLC etc...in each cell if any match found then paste it next col D cell.

xld said there is an example in the help, but I couldn't find it out. Could you help me with this. Thank u.

shrivallabha
12-17-2011, 10:35 AM
I am attaching sample AutoFilter file and a sheet on How To Do it.

Watch this youtube video for autofilter:
http://www.youtube.com/watch?v=ZUjd6Xe2snQ

karthikin
12-17-2011, 11:04 AM
@shrivallabha: Thank u. How did you filter widows xp and put in the another col D?? Can I do that for other applications like adobe,outlook, vlc & then put in the col D?? Is it some thing to do with the Auto-filter or Advanced filter??

shrivallabha
12-17-2011, 09:35 PM
I have written the steps (with screen shots) in the file which I attached in the previous post (see the other worksheet on how to do it). Have you seen the youtube video for Autofilter?

It is basically "custom filter" option which we should be used in AutoFilter.

karthikin
12-18-2011, 01:14 AM
@shrivallabha: I have downloaded the attached file of yours then I followed exactly(I know I did some mistake here)(I'm on Mac & Excel 2011 version) the steps, 1. Filter, type-->Adobe 2. In col D typed "Adobe"(one go) & Pressed Ctrl+Enter.

It copied Adobe in all the cells of col D values(Even it replaced windows xp values as Adobe in Col D). What am I doing wrong here?? Thank u.

shrivallabha
12-18-2011, 02:19 AM
@shrivallabha: I have downloaded the attached file of yours then I followed exactly(I know I did some mistake here)(I'm on Mac & Excel 2011 version) the steps, 1. Filter, type-->Adobe 2. In col D typed "Adobe"(one go) & Pressed Ctrl+Enter.

It copied Adobe in all the cells of col D values(Even it replaced windows xp values as Adobe in Col D). What am I doing wrong here?? Thank u.
I am sorry but I have never used Mac OS so I do not know if Excel shortcuts are different. There's one guy mikericson who uses Mac. He might guide us in this Mac matter.

How much do you know about formulas? Especially ARRAY formulas. Here's a link to the ARRAY functions section where Bob Phillips (XLD) has explained some of them [especially SUMPRODUCT] in detail.
http://www.vbaexpress.com/forum/forumdisplay.php?f=98
The first distinct difference between normal formula and ARRAY formula is that:
You need to enter them with a combination of CTRL + SHIFT + ENTER keys pressed at a time.

I have used one of these ARRAY functions option. The formula is ARRAY entered and copied down to the last row:

=INDEX($E$2:$E$5,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$5,$C2,1)),0),1)

I am attaching the file.

karthikin
12-18-2011, 02:39 AM
This is great. Please tell me, how can i add .Net FrameWork, SoundMax etc..in the array formula??? and verify??(Please explain me here for windows, soon i'll install windows & verify). Thank you so much.

shrivallabha
12-18-2011, 03:20 AM
I have written those Search Criteria in column E in cells as below:
E2 : Windows XP
E3 : Adobe
E4 : IBM
E5 : VLC.
This range is referred in the formula as below (See blue part):
=INDEX($E$2:$E$5,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$5,$C2,1)),0),1)

Suppose you want to add 2 items then you will have to write them in
E6 : .NET FrameWork
E7 : SoundMax

Then in cell C2 edit the formula above to adjust range reference as (see only red marked adjustment):
=INDEX($E$2:$E$7,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$7,$C2,1)),0),1)

Then press CTRL + SHIFT + ENTER otherwise it will result in #N/A error and copy it down to last row. NOTE: When you enter the formula correctly Excel will surround it with {} curly braces automatically.

karthikin
12-18-2011, 03:28 AM
Great, I'll learn it ASAP. I thank you very much once again!!

shrivallabha
12-18-2011, 03:34 AM
Great, I'll learn it ASAP. I thank you very much once again!!
Good Luck:beerchug:

karthikin
12-19-2011, 01:31 AM
@shrivallabha: Good-morning, now I'm on windows office 2007 & I have followed your procedure still couldn't extract the .Net Framework, SoundMax etc.. still I couldn't succeed.

I have attached my original file herehttp://www.uploadmb.com/dw.php?id=1324283106
for your reference. I have this vba code to remove special characters

Sub Parse()
'
' Parse Macro
' Parse the files of REXEL
'

Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\5200.csv"

' Parse it using comma and semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

' Delete columns of ComputerSerial & UserName

' Columns("B:B").Select
' Selection.Delete Shift:=xlToLeft

' Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft

'remove col b(computer serial) & col d(emp no)
Range("B:B,D:D").Delete
Range("D1").FormulaR1C1 = "Application_ID"

End Sub



So, in the col D I want to put those matched items like Windows XP, IBM, Adobe, VLC, .Net Framework, SoundMax, Office, Outlook etc...

http://www.uploadmb.com/dw.php?id=1324283386 This link has the file which i followed your formula to match the search items which didn't work.

Thank u!!

shrivallabha
12-19-2011, 06:09 AM
The formula works. See attached file. I have extended it to cell E15 so you can type new criteria in those empty cells [E8:E15] and see changes directly.

karthikin
12-19-2011, 06:37 AM
@shrivallabha:

"Then in cell C2 edit the formula above to adjust range reference as (see only red marked adjustment):
=INDEX($E$2:$E$7,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$7,$C2,1)),0),1)"

You have asked me to enter the formula in cell C2, I tried the formula in ""cell D2"" & followed your formula, it works fine when i tried with a new file.

Can i use this formula directly in the VBA code itself???

Thank u once again!!!

shrivallabha
12-19-2011, 06:57 AM
@shrivallabha:

"Then in cell C2 edit the formula above to adjust range reference as (see only red marked adjustment):
=INDEX($E$2:$E$7,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$7,$C2,1)),0),1)"

You have asked me to enter the formula in cell C2, I tried the formula in ""cell D2"" & followed your formula, it works fine when i tried with a new file.

Can i use this formula directly in the VBA code itself???

Thank u once again!!!
Yes that was a typo, it should have been D2. Apologies.

Sure, use something like:
Public Sub AddFormula()
Dim lLR As Long
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX($E$2:$E$15,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$15,$C2,1)),0),1)"
Range("D2").AutoFill Destination:=Range("D2:D" & lLR)
End Sub

karthikin
12-19-2011, 07:03 AM
Sorry for bothering you so much. Can i enter those search values in the formula itself like an array??? Do i have to follow the normal procedure??

I understand the rest except this line : Range("A" & Rows.Count).End(xlUp).Row

Thank u very much..!!

shrivallabha
12-19-2011, 07:19 AM
That is for finding out the last data filled row.

I think as of now you will be better off writing those search criteria in column E and then passing them through the above code.

In fact, there is no need to use the formula, it can be done through VBA without that.

karthikin
12-19-2011, 07:36 AM
ok. Sub Parse()
'
' Parse Macro
' Parse the files of REXEL
'

Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\4408.csv"

' Parse it using comma and semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

' Delete columns of ComputerSerial & UserName

' Columns("B:B").Select
' Selection.Delete Shift:=xlToLeft

' Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft

Range("B:B,D:D").Delete
'Range("D1").FormulaR1C1 = "Application_ID"
Call AddFormula

End
End Sub

Sub AddFormula()
Dim lLR As Long
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX($E$2:$E$15,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$15,$C2,1)),0),1)"
Range("D2").AutoFill Destination:=Range("D2:D" & lLR)
End Sub



I would like to do the search directly in the VBA code without entering any search values in the "Col E". How can I add the search values directly in the formula itself??(I'm not sure you call it as a formula or VBA code)!!

Thank U.

shrivallabha
12-19-2011, 07:58 AM
ok. Sub Parse()
'
' Parse Macro
' Parse the files of REXEL
'

Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\4408.csv"

' Parse it using comma and semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

' Delete columns of ComputerSerial & UserName

' Columns("B:B").Select
' Selection.Delete Shift:=xlToLeft

' Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft

Range("B:B,D:D").Delete
'Range("D1").FormulaR1C1 = "Application_ID"
Call AddFormula

End
End Sub

Sub AddFormula()
Dim lLR As Long
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX($E$2:$E$15,MATCH(1,--ISNUMBER(SEARCH($E$2:$E$15,$C2,1)),0),1)"
Range("D2").AutoFill Destination:=Range("D2:D" & lLR)
End Sub


I would like to do the search directly in the VBA code without entering any search values in the "Col E". How can I add the search values directly in the formula itself??(I'm not sure you call it as a formula or VBA code)!!

Thank U.

Just to continue with the previous approach. Now you can add your criteria items to Array.
Public Sub AddFormula()
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
'************************************************************************** ***************
'Add as many items you like to this array
'************************************************************************** ***************
vArray = Array("Windows XP", "Adobe", "IBM", "VLC")
For i = LBound(vArray) To UBound(vArray)
sString = sString & Chr(34) & vArray(i) & Chr(34) & ","
Next i
'************************************************************************** ***************
'This is the final array string that we pass to array formula
'************************************************************************** ***************
sString = "{" & Left(sString, Len(sString) - 1) & "}"
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX(" & sString & ",MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0),1)"
Range("D2").AutoFill Destination:=Range("D2:D" & lLR)
End Sub

karthikin
12-19-2011, 08:11 AM
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
'************************************************************************** ***************
'Add as many items you like to this array
'************************************************************************** ***************
vArray = Array("Windows XP", "Adobe", "IBM", "VLC")
For i = LBound(vArray) To UBound(vArray)
sString = sString & Chr(34) & vArray(i) & Chr(34) & ","
Next i
'************************************************************************** ***************
'This is the final array string that we pass to array formula
'************************************************************************** ***************
sString = "{" & Left(sString, Len(sString) - 1) & "}"
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX(" & sString & ",MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0),1)"
Range("D2").AutoFill Destination:=Range("D2:D" & lLR)

this just works for "Windows XP" for the rest it's not working "Adobe", "IBM", "VLC". I don't know what is the problem :(

shrivallabha
12-19-2011, 08:14 AM
I know the problem. Replace this:
Range("D2").FormulaArray = "=INDEX(" & sString & ",MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0),1)"
with:
Range("D2").FormulaArray = "=INDEX(" & sString & ",1,MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0))"

I did not pay attention to the data transpose.

karthikin
12-19-2011, 08:20 AM
ok, everything is fine. I thank you very much once again :). Could you suggest me some links to learn some basic concepts in VBA.

shrivallabha
12-20-2011, 06:25 AM
You are welcome.

Take a look at this list which I think would be very helpful for you.
http://www.mrexcel.com/forum/showpost.php?p=2676997&postcount=5

karthikin
12-21-2011, 02:07 AM
@shrivallabha: In this formula, if enter more than 10 values it display an error message impossible to define formula array property class.

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", "Windows Media", "J2SE", "MSXML") this works.

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", "Windows Media", "J2SE", "MSXML", "ATI", "XML") this doesn't work. Lets say I have 12 items in this array, it display an error message impossible to define formula array property class.

What should i do here??

I can save this file as ActiveWorkbook.SaveAs "C:\Users\karthic.rangaraj\Desktop\4401.xls", FileFormat:=56
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (workbook with macro's in 2007)

but How can i access a bunch of CSV files in a folder
& Save it as a XLS file in the same folder after the process is done using VBA with the same file names as XLS file??

Thank u very much.

karthikin
12-21-2011, 04:41 AM
The maximum length of arrayformula that VBA can create is 255 characters, that is the reason I couldn't enter more than 10 items(exceeds more than 255 ch).

How can i perform something like this: ThisWorkbook.Names.Add Name:="MyList", _RefersTo:=Array(Array("Windows XP", "Adobe", "IBM") then refer to the formula?? Thank u

shrivallabha
12-21-2011, 06:56 AM
Instead we can use VBA based (Non-Formula) approach which will work.

And a caution:
Keyword "ATI" is little problematic as ATI is graphics card I suppose but it can reflect anywhere like installation which isn't ATI you'd be looking for. I have placed spaces on its both sides assuming it will be something like HD ATI Radeon...

Here's the code:
Option Explicit
Sub FindKeys()
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
Dim i As Integer

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", " ATI ", "XML", "MSXML")

lLR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = LBound(vArray) To UBound(vArray)
Range("A1:C" & lLR).AutoFilter Field:=3
Range("A1:C" & lLR).AutoFilter Field:=3, Criteria1:="*" & vArray(i) & "*"
On Error Resume Next
Range("D2:D" & lLR).SpecialCells(xlCellTypeVisible).Value = vArray(i)
On Error GoTo 0
Range("A1:C" & lLR).AutoFilter Field:=3
Next i
Application.ScreenUpdating = True

End Sub

karthikin
12-21-2011, 07:16 AM
@shrivallabha:
Sub Parse()
'
' Parse Macro
' Parse the files of REXEL
'

Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\4408.csv"

' Parse it using comma and semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

' Delete columns of ComputerSerial & UserName

' Columns("B:B").Select
' Selection.Delete Shift:=xlToLeft

' Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft

Range("B:B,D:D").Delete
'Range("D1").FormulaR1C1 = "Application_ID"
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
'************************************************************************** ***************
'Add as many items you like to this array
'************************************************************************** ***************
ThisWorkbook.Names.Add Name:="MyList", RefersTo:=Array(Array("ATI", "Printer"))

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", "Windows Media", "J2SE", "MSXML")
For i = LBound(vArray) To UBound(vArray)
sString = sString & Chr(34) & vArray(i) & Chr(34) & ","
Next i
'************************************************************************** ***************
'This is the final array string that we pass to array formula
'************************************************************************** ***************
sString = "{" & Left(sString, Len(sString) - 1) & "}"
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX(" & sString & ",1,MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0))"

Range("D2").AutoFill Destination:=Range("D2:D" & lLR)

ActiveWorkbook.SaveAs "C:\Users\karthic.rangaraj\Desktop\4408.xls", FileFormat:=56
'56 = xlExcel8 (97-2003 format in Excel 2007, .xls)

End Sub


Sub FindKeys()
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
Dim i As Integer

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", " ATI ", "XML", "MSXML", "PDF Creator", "ATI Display", "Roxio", "Epson")

lLR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = LBound(vArray) To UBound(vArray)
Range("A1:C" & lLR).AutoFilter Field:=3
Range("A1:C" & lLR).AutoFilter Field:=3, Criteria1:="*" & vArray(i) & "*"
On Error Resume Next
Range("D2:D" & lLR).SpecialCells(xlCellTypeVisible).Value = vArray(i)
On Error GoTo 0
Range("A1:C" & lLR).AutoFilter Field:=3
Next i
Application.ScreenUpdating = True

End Sub




This is the final code it's not working there is an error here in this line Range("A1:C" & lLR).AutoFilter Field:=3

Thank you very much.

karthikin
12-21-2011, 08:30 AM
@shrivallabha:
vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", " ATI ", "XML", "MSXML", "PDF Creator", "ATI Display", "Roxio", "Epson")

This line has the error:Range("A1:C" & lLR).AutoFilter Field:=3
I would like to have more than 30 items in this array then perform the search. I thank you very much once again.

shrivallabha
12-21-2011, 09:31 AM
The code works here just fine. I just wonder what is wrong:think:. Can you post the non-working file.

karthikin
12-21-2011, 09:44 AM
http://www.uploadmb.com/dw.php?id=1324485706
<A HREF='http://www.uploadmb.com/dw.php?id=1324485706'>4408.csv</A>

Sub Parse()
'
' Parse Macro
' Parse the files of REXEL
'

Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\4408.csv"

' Parse it using comma and semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

' Delete columns of ComputerSerial & UserName

' Columns("B:B").Select
' Selection.Delete Shift:=xlToLeft

' Columns("C:C").Select
'Selection.Delete Shift:=xlToLeft

Range("B:B,D:D").Delete
'Range("D1").FormulaR1C1 = "Application_ID"
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
'************************************************************************** ***************
'Add as many items you like to this array
'************************************************************************** ***************
ThisWorkbook.Names.Add Name:="MyList", RefersTo:=Array(Array("ATI", "Printer"))

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", "Windows Media", "J2SE", "MSXML")
For i = LBound(vArray) To UBound(vArray)
sString = sString & Chr(34) & vArray(i) & Chr(34) & ","
Next i
'************************************************************************** ***************
'This is the final array string that we pass to array formula
'************************************************************************** ***************
sString = "{" & Left(sString, Len(sString) - 1) & "}"
lLR = Range("A" & Rows.Count).End(xlUp).Row
Range("D2").FormulaArray = "=INDEX(" & sString & ",1,MATCH(1,--ISNUMBER(SEARCH(" & sString & ",$C2,1)),0))"

Range("D2").AutoFill Destination:=Range("D2:D" & lLR)

ActiveWorkbook.SaveAs "C:\Users\karthic.rangaraj\Desktop\4408.xls", FileFormat:=56
'56 = xlExcel8 (97-2003 format in Excel 2007, .xls)

End Sub


Sub FindKeys()
Dim lLR As Long
Dim vArray As Variant
Dim sString As String
Dim i As Integer

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", " ATI ", "XML", "MSXML", "PDF Creator", "ATI Display", "Roxio", "Epson")

lLR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = LBound(vArray) To UBound(vArray)
Range("A1:C" & lLR).AutoFilter Field:=3
Range("A1:C" & lLR).AutoFilter Field:=3, Criteria1:="*" & vArray(i) & "*"
On Error Resume Next
Range("D2:D" & lLR).SpecialCells(xlCellTypeVisible).Value = vArray(i)
On Error Goto 0
Range("A1:C" & lLR).AutoFilter Field:=3
Next i
Application.ScreenUpdating = True

End Sub

This is the complete code & i'm getting error message in this line:Range("A1:C" & lLR).AutoFilter Field:=3

shrivallabha
12-21-2011, 10:34 AM
Try this:
Public Sub ImportData()
Dim wb As Workbook
Dim ws As Worksheet
Dim lLR As Long
Dim vArray As Variant
Dim i As Integer

Application.ScreenUpdating = False
Set wb = ThisWorkbook
Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\4408.csv"
ActiveWorkbook.Sheets(1).Copy Before:=wb.Sheets(1)
Set ws = wb.Sheets(1)

With ws

' Parse it using comma and semicolon as delimiters
.Range(.Range("A1"), .Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

.Range("B:B,D:D").Delete

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", "ATI ", "XML", "MSXML", "PDF Creator", "ATI Display", "Roxio", "Epson")

lLR = .Range("A" & Rows.Count).End(xlUp).Row

For i = LBound(vArray) To UBound(vArray)
.Range("A1:C" & lLR).AutoFilter Field:=3
.Range("A1:C" & lLR).AutoFilter Field:=3, Criteria1:="*" & vArray(i) & "*"
On Error Resume Next
.Range("D2:D" & lLR).SpecialCells(xlCellTypeVisible).Value = vArray(i)
On Error GoTo 0
.Range("A1:C" & lLR).AutoFilter Field:=3
Next i

.Move

End With

ActiveWorkbook.SaveAs "C:\Users\karthic.rangaraj\Desktop\4408.xls", FileFormat:=56
'56 = xlExcel8 (97-2003 format in Excel 2007, .xls)
Application.ScreenUpdating = True

End Sub

karthikin
12-21-2011, 11:11 AM
Yeah it works on Mac, I'm sure it'll work windows too. Thank u very much once again.

Could you please tell me how can i access a bunch of CVS files in a folder & apply this code & save it as .xls files of the same file name??

Thanks a lot.

shrivallabha
12-21-2011, 11:24 AM
Its close to midnight here in Mumbai so I will go to bed now. Tomorrow I will take a look at it if it has not been addressed.

shrivallabha
12-22-2011, 01:26 AM
Here's the code:
Option Explicit
Public Sub ProcessCSVfilesINaFOLDER()
Dim wb As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim lLR As Long
Dim vArray As Variant
Dim i As Integer, iFCount As Integer
Dim sFile As String, sName As String

Application.ScreenUpdating = False
Set wb = ThisWorkbook

sFile = Dir$("C:\Users\karthic.rangaraj\Desktop\*.csv", vbNormal)

Do Until LenB(sFile) = 0

sName = Left(sFile, Len(sFile) - 4)
'
Workbooks.OpenText Filename:="C:\Users\karthic.rangaraj\Desktop\" & sFile

Set ws = ActiveWorkbook.Sheets(1)

With ws

' Parse it using comma and semicolon as delimiters
.Range(.Range("A1"), .Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 2))

.Range("B:B,D:D").Delete

vArray = Array("Windows XP", "Adobe", "IBM", "VLC", ".Net Framework", "Office", "Java", _
"Windows Media", "J2SE", "ATI ", "XML", "MSXML", "PDF Creator", "ATI Display", "Roxio", "Epson")

lLR = .Range("A" & Rows.Count).End(xlUp).Row

For i = LBound(vArray) To UBound(vArray)
.Range("A1:C" & lLR).AutoFilter Field:=3
.Range("A1:C" & lLR).AutoFilter Field:=3, Criteria1:="*" & vArray(i) & "*"
On Error Resume Next
.Range("D2:D" & lLR).SpecialCells(xlCellTypeVisible).Value = vArray(i)
On Error GoTo 0
.Range("A1:C" & lLR).AutoFilter Field:=3
Next i

.Copy

End With
With ActiveWorkbook
.SaveAs "C:\Users\karthic.rangaraj\Desktop\" & sName & ".xls", FileFormat:=56
'56 = xlExcel8 (97-2003 format in Excel 2007, .xls)
.Close
End With
Workbooks(sFile).Close SaveChanges:=False
sFile = Dir$
iFCount = iFCount + 1
Loop

MsgBox "Finished Processing of " & iFCount & " CSV Files!"
Application.ScreenUpdating = True

End Sub

karthikin
12-22-2011, 02:25 AM
@shrivallabha: This is awesome!!! Thank you very much once again!!

I have 3 more question, the array is quite big I have around 100 keywords, so it taking a bit more time.

1.It's showing me the message "would like to replace the contents in the same place" 3 times, can I avoid this message??

2.I have 15 files & it takes around 2 mins to finish, is this normal??(I know it depends upon the content of data, just little bit curious to know)

3. How can I read all the XLS files in a folder & copy all the data in an another XLS file??

Please take your time to answer these questions!! Thank you very much once again!!

shrivallabha
12-22-2011, 06:18 AM
@shrivallabha: This is awesome!!! Thank you very much once again!!

I have 3 more question, the array is quite big I have around 100 keywords, so it taking a bit more time.

1.It's showing me the message "would like to replace the contents in the same place" 3 times, can I avoid this message??

2.I have 15 files & it takes around 2 mins to finish, is this normal??(I know it depends upon the content of data, just little bit curious to know)

3. How can I read all the XLS files in a folder & copy all the data in an another XLS file??

Please take your time to answer these questions!! Thank you very much once again!!
1. Add following lines at the beginning of the code and end of the code as below just next to screenupdating line as below.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'The code is here
Application.ScreenUpdating = True
Application.DisplayAlerts = True

2. I have no idea but I guess it is OK. And with those alerts coming in between (Your point 1) we might have different time clocking.

3. Thats a similar question but not the same. Start a new thread with clear requirements.

karthikin
12-22-2011, 06:29 AM
Ok fine, i'll do this. Thank u very much once again :)