PDA

View Full Version : Solved: Mark as XXXXX



justdriving
09-12-2011, 02:17 PM
Using values given on LHS of Sheet1, I want to fill up data on RHS. How can I do it in VBA?

Bob Phillips
09-12-2011, 04:12 PM
Sub ProcessData()
Dim lastRow As Long
Dim colType As Long
Dim rowProduct As Long
Dim numRows As Long
Dim i As Long

With Worksheets("Sheet1")

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow

If .Cells(i, "C").Value <> "" Then

numRows = Application.CountIf(.Columns("A"), .Cells(i, "A").Value)
colType = Application.Match(.Cells(i, "C").Value, .Cells(1, "H").Resize(, 3), 0)
rowProduct = Application.Match(.Cells(i, "A").Value, .Columns("G"), 0)
.Cells(rowProduct, 7 + colType).Resize(numRows).Value = "XXXX"
End If
Next i
End With
End Sub

justdriving
09-13-2011, 12:10 PM
Hi ,

I indeed appreciate this code. But, when I changed the order of data in Col G and removed "111" from this col, then I got error. So, I request your help.

If "any" PRODUCT ID data not found in Col G then
Just write "not found" in respective Col H , I or J
else
above program
End IF


Many thanks.

Bob Phillips
09-13-2011, 12:31 PM
Sub ProcessData()
Dim lastRow As Long
Dim colType As Long
Dim rowProduct As Long
Dim numRows As Long
Dim i As Long

With Worksheets("Sheet1")

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("H2").Resize(lastRow, 3).ClearContents
For i = 2 To lastRow

If .Cells(i, "C").Value <> "" Then

numRows = Application.CountIf(.Columns("A"), .Cells(i, "A").Value)
colType = Application.Match(.Cells(i, "C").Value, .Cells(1, "H").Resize(, 3), 0)
On Error Resume Next
rowProduct = Application.Match(.Cells(i, "A").Value, .Columns("G"), 0)
On Error GoTo 0
If rowProduct > 0 Then

.Cells(rowProduct, 7 + colType).Resize(numRows).Value = "XXXX"
End If
End If
Next i
End With
End Sub

justdriving
09-13-2011, 01:05 PM
That worked... This will be final query, if I am not disturbing you... I have extended Col G:J to n-th col, due to various reasons. Now, each col containing PRODUCT ID have varying length. How can I use above program to cover those extended Col also?

Bob Phillips
09-13-2011, 01:31 PM
Sub ProcessData()
Dim lastRow As Long
Dim colType As Long
Dim rowProduct As Long
Dim numRows As Long
Dim i As Long, ii As Long

With Worksheets("Sheet1")

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 7 To 19 Step 4

.Cells(2, i + 1).Resize(lastRow, 3).ClearContents
Next i

For i = 2 To lastRow

If .Cells(i, "C").Value <> "" Then

numRows = Application.CountIf(.Columns("A"), .Cells(i, "A").Value)

For ii = 7 To 19 Step 4

colType = Application.Match(.Cells(i, "C").Value, .Cells(1, ii + 1).Resize(, 3), 0)
rowProduct = 0
On Error Resume Next
rowProduct = Application.Match(.Cells(i, "A").Value, .Columns(ii), 0)
On Error GoTo 0
If rowProduct > 0 Then

.Cells(rowProduct, ii + colType).Resize(numRows).Value = "XXXX"
End If
Next ii
End If
Next i
End With
End Sub

justdriving
09-13-2011, 01:43 PM
Great Bob... That Worked ... but, when I duplicated rows in certain columns, it was not able to extend and XXXX mark in duplicate rows... Please advice me ... or can we use Find method instead of Match method?

Bob Phillips
09-13-2011, 04:36 PM
Are you saying now that a product could be duplicated in a target group, and you want all instances populated?

justdriving
09-14-2011, 11:19 AM
I tried to work on this program. I think some steps need your advice.
I think it will be best to create an UDF similar to MATCH overcoming Match's demerits that it can only find position of first match.


Private Sub Workbook_Open()


Dim lastRow, lastCol, RowtoClear As Long
Dim colType As Long
Dim rowProduct, nextrowProduct As Long
Dim numRows As Long
Dim i As Long, ii As Long

With Worksheets("Main")

'rows appear as 1,2,3 ... Columns appear as A,B,C ...

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For i = 7 To lastCol Step 4
RowtoClear = .Cells(.Rows.Count, i).End(xlUp).Row - 1
.Cells(2, i + 1).Resize(RowtoClear, 3).ClearContents
Next i

For i = 2 To lastRow

If .Cells(i, "C").Value <> "" Then

numRows = Application.CountIf(.Columns("A"), .Cells(i, "A").Value)

For ii = 7 To lastCol Step 4

colType = Application.Match(.Cells(i, "C").Value, .Cells(1, ii + 1).Resize(, 3), 0)
rowProduct = 0
nextrowProduct = 0
On Error Resume Next
rowProduct = Application.Match(.Cells(i, "A").Value, .Columns(ii), 0)

'We need to find "Match array" which starts from rowProduct+1 to end-of-column, _
'because Match finds only 1st Match, when Match type is 0.
'Something like: -

' Do _
'find "Match array / range" which starts from rowProduct+1 to end-of-colum _
'nextrowProduct = nextrowProduct + 1 _
'Loop until it reaches end of column , like .End(xlDown)


On Error GoTo 0
If Not IsError(rowProduct) Then
.Cells(rowProduct, ii + colType).Value = "XXXXX"
End If


If Not IsError(rowProduct) Then
rowProduct = Application.Match(.Cells(i, "A").Value, .Columns(ii), 0)
nextrowProduct = Application.Match(.Cells(i, "A").Value, .Cells(rowProduct + 1, ii).Resize(.End(xlDown), 1), 0)
End If
If Not IsError(nextrowProduct) Then
.Cells(nextrowProduct, ii + colType).Value = "Duplicate"
End If

Next ii
End If
Next i
End With




End Sub

' One concern is that Col G, or K or S or +4th Col can have Duplicate entries.
' These duplicate entries will not necessarily appear one after another. _
' They can appear anwhere within COL.
'
' I can use sort method to sort data ...
' but it will distort the position of data entry in COL A ..
' which is not allowed to me.

Bob Phillips
09-14-2011, 02:50 PM
Turn it around



Sub ProcessData()
Dim lastRow As Long
Dim colType As Long
Dim rowProduct As Long
Dim i As Long, ii As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")

For i = 7 To 19 Step 4

lastRow = .Cells(.Rows.Count, i).End(xlUp).Row
.Cells(2, i + 1).Resize(lastRow, 3).ClearContents

For ii = 2 To lastRow

rowProduct = 0
On Error Resume Next
rowProduct = Application.Match(.Cells(ii, i).Value, .Columns("A"), 0)
On Error GoTo 0

If rowProduct > 0 Then

If .Cells(rowProduct, "C").Value <> "" Then

colType = Application.Match(.Cells(rowProduct, "C").Value, .Cells(1, i + 1).Resize(, 3), 0)
.Cells(ii, i + colType).Value = "XXXX"
End If
End If
Next ii
Next i
End With

Application.ScreenUpdating = True
End Sub

justdriving
09-15-2011, 11:55 AM
Yes, it worked... thank you... many times

justdriving
09-17-2011, 07:35 AM
I also found that this solution was much better than: -



'http://www.youtube.com/watch?v=vbHNNt3w9M4



Thanks Bob, Many thanks

Bob Phillips
09-17-2011, 09:22 AM
The YouTube solution is better than mine, is that what you are saying?

justdriving
09-17-2011, 09:27 AM
NEVER.

:beerchug:

Bob Phillips
09-17-2011, 10:01 AM
It's just that a quick glance at it did not make it clear to me how it solved your problem. But it does use PowerPivot, do you have that available to you?

justdriving
09-17-2011, 11:11 AM
I wanted to say that above solution (post # 10) was better invented. I have not tested till now solution given in Youtube.

Bob Phillips
09-17-2011, 11:22 AM
Yeah, but have you tried PowerPivot. It has many shortcomings, but is very young, and it is amazing.

justdriving
09-17-2011, 03:18 PM
Requesting your help to mark this thread as "Solved". I don't have this privilege, perhaps.

Aussiebear
09-17-2011, 04:57 PM
Requesting your help to mark this thread as "Solved". I don't have this privilege, perhaps.

Are you sure? Go to Thread tools dropdown and check for me please?