PDA

View Full Version : Need help on VBA coding....



ravi_firedup
07-16-2010, 04:20 AM
Hi All,
I am new to this place & i am wrking on some automation i tried a lot and finally gave up, so my last option is to check with the Experts. I hope i will get the solution here or else i have to drop out the Automation itself. Kindly assist me. Here r the details

1) I have a feilds from col J to Col N, not in all the fields data (Numbers) are available (Randam data)
2)The data is color coded in Blue (Font.ColorIndex = 5)
3) Logic : first the conduction should check for Col J then if there is no color code then it should move to Col K, then to Col L, Col M, Col N.
4) If in either of this field data is available with color code then it should copy and paste the data into next tab.
5) Next step is it should move to next Row to search for the above conduction.

Eg :

Col J Col K Col L Col M Col N
Row 1 : 1.0 2.0
Row 2 : 1.0
Row 3 : 1.0 1.0 1.0
Row 4 : 1.0

Only logic is in each row it should search for data with color font Blue if its there then i should copy the entire row to new sheet or it should move to next Row. But the same entry should not repeat twice.
Eg in Row 3 there are 3 entires in the same row so it should copy and paste it only once to next tab.

I hope i have explained it better & i will get the solution for the same.....

Guys....... Plz help me !!!!!!!!!!!!!

Bob Phillips
07-16-2010, 04:47 AM
Sub CopyData()

For i = 1 To LastRow(ActiveSheet)

If (IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Then

NextLine = NextLine + 1
Rows(i).Copy Worksheets("Sheet2").Cells(NextLine, "A")
End If
Next i
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

ravi_firedup
07-16-2010, 06:05 AM
Hi Dude,

I tried copy and pasting the code into the VBA editor but the If conductions are showing in Red

If (IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Or _
(IsNumeric(Cells(i, "J").Value2 And Cells(i, "J").Font.Colorindex = 5) Then

i didnt understand where is the error. Plz help me

Bob Phillips
07-16-2010, 06:53 AM
My mistake



Sub CopyData()

For i = 1 To LastRow(ActiveSheet)

If (IsNumeric(Cells(i, "J").Value2) And Cells(i, "J").Font.ColorIndex = 5) Or _
(IsNumeric(Cells(i, "J").Value2) And Cells(i, "J").Font.ColorIndex = 5) Or _
(IsNumeric(Cells(i, "J").Value2) And Cells(i, "J").Font.ColorIndex = 5) Or _
(IsNumeric(Cells(i, "J").Value2) And Cells(i, "J").Font.ColorIndex = 5) Or _
(IsNumeric(Cells(i, "J").Value2) And Cells(i, "J").Font.ColorIndex = 5) Then

NextLine = NextLine + 1
Rows(i).Copy Worksheets("Sheet2").Cells(NextLine, "A")
End If
Next i
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

ravi_firedup
07-17-2010, 05:17 AM
Hi Dude,
Thanks for replying my query. It has almost worked but the results are little different from expected. Please assist me in this.

Data is in following format :

Col J........ Col K........ Col L........ Col M....... Col N
1.000 .....................................................1.000
................1.000
................................1.000
...............................................1.000
.............................................................2.000
1.000...........1.000.........1.000........1.000.....1.000

As per the codes provided by you these are the output :

Col J........ Col K........ Col L........ Col M....... Col N

1.000 .....................................................1.000
1.000...........1.000.........1.000........1.000.....1.000


Actual out put should capture all the Rows but it should capture only once in the next sheet.
As per the above Eg. 6 Rows in the next tab.


One more requirement is with continious to Col J to Col N there are 3 more feilds we have to check for the color coding i.e Col R, Col BJ, Col BQ

Thanks in advance for assisting me.

Aussiebear
07-20-2010, 11:27 PM
Please post a sample workbook with a "before" and "after" sheets, so we an see exactly what it is that you are chasing.

To post a workbook, click on Go Advanced, scroll down to Manage Attachments and go from there.