PDA

View Full Version : VBA macro needed: IF value is not X or Y, then copy to other sheet



attila_ujvar
12-09-2012, 12:49 AM
Hi,

I need to create a VBA macro that will run on a puch of a button (that I can do)
The problem of course is with the code.

Sheet to look up data in: 'SABER roster'
to move data if condition met: 'ROLLUP'

Check if in column 8 value of cell equals PDY or TDY. If not, copy values from same row columns 2,7,8,9,10,15 to sheet 'ROLLUP' starting in column 2, row 25

I have no clue where to even begin, thank you in advance!

patel
12-09-2012, 02:51 AM
attach a sample file with current and desired sheet

attila_ujvar
12-09-2012, 03:56 AM
See attached

omp001
12-09-2012, 06:47 AM
Firstly, in order to avoid errors to codes and to formulae I suggest for you to undo the merged cells in sheet 'ROLLUP'.
Then you could try the code below.

Sub PasteToRollup()
Dim LR As Long, k As Long, x As Long, rng()
x = 25
With Sheets("SABER roster")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
For k = 2 To LR
If .Cells(k, 8).Value <> "PDY" And .Cells(k, 8).Value <> "TDY" Then
rng = Array(.Cells(k, 2), .Cells(k, 7), .Cells(k, 8), _
.Cells(k, 9), .Cells(k, 10), .Cells(k, 15))
Sheets("ROLLUP").Cells(x, 1).Resize(, 6) = rng
x = x + 1
End If
Next k
End With
End Sub

attila_ujvar
12-09-2012, 11:36 PM
It almost works perfectly. Unfortunately I would like to be able to set the output location for each cell. For example, in this case if one row is missing a value from one of the middle columns in the range (nothing under Remarks for example), the output will be one cell shorter, and puts a value that belongs to column 6 into 5.

omp001
12-10-2012, 03:28 AM
So, if I followed you if the Remark column is blank and End date column has a value, at sheet SABER roster, then the value of End date would be inserted in column Remark at ROLLUP ? (sounds strange, but...)

It would be better if you post a sample with the desired situation.

attila_ujvar
12-10-2012, 07:18 AM
See above in post #3. on sheet 'SABER roster' column J gets copied over, as well as column O.
Sometimes there are items in column J, sometimes nothing. If there's nothing, the current code will paste values from 'SABER roster' column O into sheet 'ROLLUP' "Remarks" instead of under "End".
It also doesn't do well with the merged cell, but I'm really not sure how else to make it look appeasing...
I've seen something different but for the same effect, it looked like this:

If Worksheets("PQR").Cells(ROWER2, 7) = Worksheets("Merged DMD").Cells(ROWER1, 15) Then
Worksheets("Merged DMD").Cells(ROWER1, 16) = Worksheets("PQR").Cells(ROWER2, 12) 'PAY GRADE
Worksheets("Merged DMD").Cells(ROWER1, 17) = Worksheets("PQR").Cells(ROWER2, 5) 'SSN

And so on and so forth...