PDA

View Full Version : Excel VB Script to Fill Values Based on Common Values in an Adjacent Cell



oarsout
11-01-2021, 11:35 AM
I have a spreadsheet with a value in column B, a corresponding value in column I, and [needing] the word "Duplicate" in column J for all rows (except the first instance) where the value in column B is repeated.
I am looking for a VB script that will:


Add the word "Duplicate" in column J for all records (except the first instance) where the corresponding value in column B is duplicated.
If there is a value in column I for any one of the [duplicate] instances of column B, than copy that I value into column I for all instances.
If any instances of the value in colum B has a different I value, then highlight the cells in column I for all instances.


See the attached example. Thanks for your help.

29117

arnelgp
11-01-2021, 08:52 PM
'arnelgp
Public Sub test()


Dim t As ListObject
Dim i As Integer
Dim c As Object
Dim v As Object
Dim u As Object
Dim num As Integer, vl As Integer
Dim ky As String, s As String
'''''''''
' change Sheets(1) to sheet number of your worksheet
' and change "table4" to the name of the table
'
Set t = Sheets(1).ListObjects("table4")

Set c = CreateObject("scripting.dictionary")
Set v = CreateObject("scripting.dictionary")
Set u = CreateObject("scripting.dictionary")
c.comparemode = 1
v.comparemode = 1
u.comparemode = 1

'check for dups
For i = 1 To t.DataBodyRange.Rows.Count
ky = t.DataBodyRange(i, 1) & ""
If c.exists(ky) = False Then
c.Add ky, ky
Else
t.DataBodyRange(i, 9).Value = "Duplicate"
End If
s = t.DataBodyRange(i, 8) & ""
If Len(s) Then
num = Val(s)
If v.exists(ky) Then
If num <> v(ky) Then
If Not u.exists(ky) Then
u.Add ky, ky
End If
End If
Else
v.Add ky, num
End If
End If
Next
'hightlight
Set c = Nothing
For i = 1 To t.DataBodyRange.Rows.Count
ky = t.DataBodyRange(i, 1)
If u.exists(ky) Then
t.DataBodyRange(i, 8).Interior.Color = vbYellow
Else
s = t.DataBodyRange(i, 8) & ""
If Len(s) = False Then
t.DataBodyRange(i, 8).Value = v(ky)
End If
End If
Next

End Sub

oarsout
11-02-2021, 05:59 AM
Thank you, arnelgp. The script didn't like the name of my tab, so I changed it to "Sheet1" but then it errored on Ln 32 (num = Val(s)). I'll attach the actual file. Thanks again for your time.

arnelgp
11-02-2021, 06:26 AM
it doesn't have Any numbers of column I (like you showed on post#1).
so where can we find this number?

arnelgp
11-02-2021, 06:58 AM
i change the code slightly.
fetch it here:
https://www.dropbox.com/s/y3nz7tcuulpsvfa/Master%20P2P3%20jiras%20for%20CL%20V11.52.242%20onwards%28ARNELGP%29.zip?dl =0

oarsout
11-02-2021, 09:34 AM
Thanks so much, arnelgp. This is very helpful. :thumb