VBA for search -> add -> delete

[keresztesi]

Hi,

I'd like to have a vba code for the following:

1. the code should search for numeric value in column "V" (there is either only one cell with number or all cells are blank). If there's a nr. then:
2. in the row where the number is (for example it's the 20th) it searches again for a number in range W20:AA20
3. then it searches again for numeric values in range W2:AA1000 and if it finds a value that is greater then the one found in range W20:AA20 then it adds the value from column "V"
4. finally it deletes the numeric value from column "V"

For example:

BEFORE:

	V	W	X	Y	Z	AA
1		1				10
2		2		5
3				6
4				4
5
6		3
7
8					9
9					8
10					7

<tbody>
</tbody>

AFTER:

	V	W	X	Y	Z	AA
1		1				15
2		2		10
3				11
4	5			9
5
6		3
7
8					14
9					13
10					12

<tbody>
</tbody>

Thx in advance!

Zoli

 

[keresztesi]

Ok, so let's make it so:

Col 'V' := column where it should search for a number
Range : X:AB
In case there are more values in range then it should select the value given in column 'W'

Is it ok so?

If you put a value in column AB for example then its ok yes.

 

[steve the fish]

Lets try this. Try on a copy workbook first! There are no sheets here so make sure the sheet you want it to work on is the active sheet when you run it.

Dim lr As Long, rw As Long, myVal1 As Double, myVal2 As Double, arr

'no value in column V exit
If Application.Count(Columns("V")) = 0 Then Exit Sub

'get various values
lr = Columns("V:AB").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
rw = Evaluate("MATCH(TRUE,INDEX(ISNUMBER(V1:V" & lr & "),0),0)")
myVal1 = Evaluate("INDEX(V1:V" & lr & "," & rw & ")")
cnt = Application.Count(Range(Cells(rw, 24), Cells(rw, 28)))

If cnt <> 1 Then
    myVal2 = Cells(rw, 23)
Else
    myVal2 = Evaluate("INDEX(X" & rw & ":AB" & rw & ",MATCH(TRUE,INDEX(ISNUMBER(X" & rw & ":AB" & rw & "),0),0))")
End If

'add range into array
arr = Range("X1:AB" & lr)

'alter array as appropriate
For i = LBound(arr, 1) To UBound(arr, 1)
    For j = LBound(arr, 2) To UBound(arr, 2)
        If arr(i, j) > myVal2 Then arr(i, j) = arr(i, j) + myVal1
    Next
Next

'put array back on worksheet
Range("X1:AB" & lr) = arr

'clear column V
Columns("V").ClearContents

 

[keresztesi]

Run-time error '13'
Type mismatch

Highlighted the following :

"arr(i, j) = arr(i, j) + myVal1"

 

[steve the fish]

Try this instead:

If IsNumeric(arr(i, j)) And arr(i, j) > myVal2 Then arr(i, j) = arr(i, j) + myVal1

 

[keresztesi]

Ok, it runs but please, correct 2 things:

1. it doesn't add the number to the first number in the range (to the value in the where the founded number is)
2. after run delete column 'W' as well

Thx

Try this instead:

If IsNumeric(arr(i, j)) And arr(i, j) > myVal2 Then arr(i, j) = arr(i, j) + myVal1

 

[steve the fish]

Dont understand what 1 means?

 

[keresztesi]

Sorry for my english

Ok, I explain it by example:

The code finds number '5' in column "V" and in row nr. 10.
In row 10 in range X10:AB10 there is a number 20.

The code should add 5 to 20

Dont understand what 1 means?

 

[keresztesi]

I think it does the trick:

If IsNumeric(arr(i, j)) And arr(i, j) >= myVal2 Then arr(i, j) = arr(i, j) + myVal1

Sorry for my english

Ok, I explain it by example:

The code finds number '5' in column "V" and in row nr. 10.
In row 10 in range X10:AB10 there is a number 20.

The code should add 5 to 20

 

[keresztesi]

and for deleting col 'W' I added

Columns("W").ClearContents

 

[keresztesi]

steve the fish, thank you for your help!
It saved my life!

Thanks