Saturday 26 August 2017

How to find and replace randomly with rate of two multiple values in the same row by excel?


Suppose that value 18 and value 4 are in the same row but the value 4 must be only 70% with value 18 in all rows of my data. How can I correct that and change only 30% of the value 4 Randomly with any value for all rows that have value 18? See the picture below:


Sample of My Question



Answer



Based on how I understand your question, try this code and confirm if this works for you.


In this example sample data is in B1:F23. The 4's are checked only in 3rd column.


Press Alt+F11 to access VBA Editor. From Insert Menu insert a Module. Double click on the module name in Left Pane to access it's Code Editor. Now put the following macro code in it.


Sub Replace430()

Dim MyRange As Range
Dim RowCount As Long
Dim ColCount As Integer
Dim MyArray() As Variant

Dim i, j, k, percent30 As Long
Dim Count4 As Long
Const Replaced = 0 'Set Replaced Value
Const found = 18 'Set Find Value
Const Mycol = 3 'Correctly set the Column Number of Column in Range where 4 is to be checked
Set MyRange = Range("B2:F23")

RowCount = MyRange.Rows.Count
ColCount = MyRange.Columns.Count
'Get number of 4's againts 18
For i = 1 To RowCount
If MyRange.Columns(1).Cells(i) = found Then
For j = Mycol To Mycol
If MyRange.Columns(j).Cells(i) = 4 Then
Count4 = Count4 + 1
End If
Next j
End If

Next i

ReDim MyArray(Count4 - 1, 2)
k = 0
For i = 1 To RowCount
If MyRange.Columns(1).Cells(i) = found Then
For j = Mycol To Mycol
If MyRange.Columns(j).Cells(i) = 4 Then
MyArray(k, 1) = i
MyArray(k, 2) = j
k = k + 1
End If
Next j
End If

Next i

percent30 = 0.3 * Count4

Dim shufflearray()
ReDim shufflearray(Count4 - 1)
For i = 0 To Count4 - 1
shufflearray(i) = i
Next i

'Shuffle the shufflearray() below


Dim N As Long
Dim Temp As Variant


Randomize
For N = LBound(shufflearray) To UBound(shufflearray)
j = CLng(((UBound(shufflearray) - N) * Rnd) + N)

If N <> j Then
Temp = shufflearray(N)
shufflearray(N) = shufflearray(j)
shufflearray(j) = Temp
End If
Next N

'Use randomised values from shufflearray as array subscript to replace only 30% of 4's
For i = 0 To percent30 - 1
MyRange.Columns(MyArray(shufflearray(i), 2)).Cells(MyArray(shufflearray(i), 1)).Value = Replaced
Next i


End Sub

Set youir range correctly at statement Set MyRange = Range("B2:F23") Set column number correctly at Const Mycol = 3


Save the file as Macro Enabled Workbook and from the worksheet press ALT + F8 to access Macro Run dialog box. Run this Macro Replace430().


Test it further and confirm. As per your comments this assumes that the 4's occur only in 3rd column of the selected range. 4's anywhere else are ignored for the time being.


enter image description here


No comments:

Post a Comment

Where does Skype save my contact&#39;s avatars in Linux?

I'm using Skype on Linux. Where can I find images cached by skype of my contact's avatars? Answer I wanted to get those Skype avat...