Solved: Mark as XXXXX

[justdriving]

Using values given on LHS of Sheet1, I want to fill up data on RHS. How can I do it in VBA?

[Bob Phillips]

[vba]

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[/vba]

[justdriving]

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.
[VBA]
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
[/VBA]

Many thanks.

[Bob Phillips]

[vba]

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
[/vba]

[justdriving]

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]

[vba]

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
[/vba]

[justdriving]

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]

Are you saying now that a product could be duplicated in a target group, and you want all instances populated?

[justdriving]

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.

[VBA]
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.


[/VBA]

[Bob Phillips]

Turn it around

[vba]

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[/vba]

[justdriving]

Yes, it worked... thank you... many times

[justdriving]

I also found that this solution was much better than: -

[VBA]

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

[/VBA]

Thanks Bob, Many thanks

[Bob Phillips]

The YouTube solution is better than mine, is that what you are saying?

[justdriving]

NEVER.

[Bob Phillips]

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]

I wanted to say that above solution (post # 10) was better invented. I have not tested till now solution given in Youtube.

[Bob Phillips]

Yeah, but have you tried PowerPivot. It has many shortcomings, but is very young, and it is amazing.

[justdriving]

Requesting your help to mark this thread as "Solved". I don't have this privilege, perhaps.

[Aussiebear]

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?