Excel Macro or VBA with conditional logic 1

[rccline]

I need to create an Excel Macro or VBA in Excel with conditional logic.

My data looks like this.

Row A B C D E F G
1 Alpha Beta Soup Book Red
2 Gamma Lamda Stew Ledger Green Hot 712
3 Beta Alpha Beans 0 0
4 Alpha Zeta Carrots 0 0
5 Mu Rho Lettuce Cards Yellow Cold 999

If any cell in column D=0, then copy the preceeding cell in D, E, F, and G to the row with the zero.

Data should look like this:

Row A B C D E F G
1 Alpha Beta Soup Book Red
2 Gamma Lamda Stew Ledger Green Hot 712
3 Beta Alpha Beans Ledger Green Hot 712
4 Alpha Zeta Carrots Ledger Green Hot 712
5 Mu Rho Lettuce Cards Yellow Cold 999


(I tried to put the data into columns, but I don't know how.)

Thanks.

 

[Gavona]

Nor precisely what you asked for but looks as if it might do the job:
Select your data.
Edit/Replace zeros with blanks,
Edit/Goto/Special blanks

then type enter,Uparrow hold ctrl and press enter

If you do this with recorder on you get

Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=+R[-1]C"

Thanks,

Gavin

 

[rccline]

That's not quite it. Column D is the predicate column with the zeros. Other columns have zeros, but they don't matter.

 

[rccline]

Maybe if I state it this way. For each cell with zero in column D, copy and paste from the row above, data from cells D through H.

I've got about 6000 rows of data to search through.

 

[Gavona]

Well, if you select only column D then use all but the last line of my code you will have selected all the zeros in column D (unless there are blanks in the original data in this column).

Then something like

For each mycell in selection
mycell.formula=
mycell.offset(1,0).formula="=+R[-1]C"
mycell.offset(2,0).formula="=+R[-1]C"
next mycell

Thanks,

Gavin

 

[Gavona]

Alternatively you could select all of column D and then test if there is a zero in it but this code is likely to take longer.
Personally I would insert some columns and use some If formulae if it is one-off.
Whichever you will of course want to copy to values after applying

..Which makes me realise that
mycell.offset(2,0).value=mycell.offset(2,-1).value
would have been a better approach



Thanks,

Gavin

 

[rccline]

I'm trying to record a macro, but can't get it to address the movement with relative offsets. Can you advise?

 

[rccline]

Here is my problem. The "relative toolbar" is not visible.
How do I make it appear?

http://www.mrexcel.com/tip077.shtml

 

[rccline]

Here's what I've got going.
I tried to make it look for zeros in column D, (my starting column), but instead of moving down the column to find the next zero, it looks to the next column to the right.




Sub removezeros()
'
' removezeros Macro
' Macro recorded 10/29/2005'
' Keyboard Shortcut: Ctrl+z
'
ActiveCell.Offset(-3, 0).Range("A1:H1").Select
Selection.Copy
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveSheet.Paste
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

 

[Gavona]

Relative toolbar:
For me it appears whenever I start recording a macro. It is called the "stop recording" toolbar. Howevever it is like any toolbar and you can make it visible, or alter the buttons on it using View, Toolbars.
Use the above approach to make the toolbar visible.
Does it have the normal two buttons?
If not the use View, Toolbars, Customise, Reset.


Thanks,

Gavin

 

[Gavona]

I may have misled you about the parameters for offset, sorry.
Your code:

ActiveCell.Offset(-3, 0).Range("A1:H1").Select

Goes to the cell 3 rows above the active cell and selects it plus the seven cells to the right of it - eight cells altogether. A:H is eight columns.

So if you want to use the Copy method then a useful starting snippet would be:

ActiveCell.Offset(-1,0).Range("A1:D1").Select
Selection Copy

Although you should avoid selecting before copying - makes life simpler and the code quicker.

ActiveCell.Offset(-1, 0).Range("A1:D1").Copy
ActiveSheet.Paste
Application.CutCopyMode = False

You don't even need to use the copy method.

ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(-1, 2).Value
etc

Or using a loop to do for each of the four columns:

For i = 0 To 3
ActiveCell.Offset(0, i).Value = ActiveCell.Offset(-1, i).Value
Next i

Thanks,

Gavin

 

[rccline]

Gavin:

Thank you very much for your clarification. There are about a thousand zeros in Column D which have to be replaced. How do I get the macro to move to the next zero in column D?

Robert

 

[Gavona]

Select the cells in column D
Then run a macro

in pseudo code:

For each MyCell in Selection
  if value of MyCell is zero then
    For i = 0 To 3
    MyCell.Offset(0, i).Value = MyCell.Offset(-1, i).Value
    Next i
  End if
Next MyCell

Excel recognises that you have selected a range of cells. MyCell is just a name you have assigned - you could as well use For each Fred in .....

Of course you do not need to test each cell individually like that. You can select all cells meeting the criteria (see my first post) and then use the above without the IF / End If.

Hope this helps you.

Thanks,

Gavin

 

[Gavona]

OK, I may not be online for a while so here is my entire solution. I have commented out the lines that test every row instead modifying the initial selection to only include cells that were zeros. I reckon this would probably be slightly faster - interested to hear if you test both methods.
Note, either way you can't select the whole of column D unless you are certain that there is not a zero or blank in cell D1 - the macro would try to look at the cell above D1 and would return an error.

Sub TestMacro()
' This first section modifies the selection to convert cells with zeros to blanks and then to select the blank cells.
Selection.Find(What:="0", _
    After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, _
    MatchCase:=False).Activate
Selection.Replace What:="0", Replacement:="", _
    LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False
Selection.SpecialCells(xlCellTypeBlanks).Select

'This second section takes each of the selected cells and the 3 cells to the right and copies the values from the row immediately above.
'The If AND end If lines are commented out but allow the values of the individual selected cells to be tested first if you don't want to use the first section.   
For Each Mycell In Selection
'If MyCell.Value = "0" Then
    For i = 0 To 3
    Mycell.Offset(0, i).Value = Mycell.Offset(-1, i).Value
    Next i
'End If
Next Mycell
End Sub

Thanks,

Gavin

 

[Gavona]

Not sure if you are still working on this but sledgehammers and nuts come to mind!

Without VBA:
Filter the column to show only the cells you want to change. Select these cells (don't forget Edit,Goto,special,visible cells only).
Take off the filter.
type "=" press up arrow then hold Ctrl and press enter

That does the job then copy all the cells in cols D to G to values (Edit,pastespecial,Values)

Using code something along these lines would work.

Sub Macro1()
'Assumes column heading is in D5, _
 database ends before row 60,000, _
 no data below the database _
 want to replace zeros with values from cel above in cols D through G
Range("D5:D60000").Select
Selection.AutoFilter
ActiveCell.Offset(1, 0).Range("D1:G60000").Select 'excludes heading from selection and extend to column G

Selection.AutoFilter Field:=1, Criteria1:="0"
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.FormulaR1C1 = "=+R[-1]C"
Selection.AutoFilter
'copy to values (you could refine selection a bit better if you have formulae in the columns that you want to keep
Columns("D:G").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
End Sub

Thanks,

Gavin

 

[rccline]

Thanks for sticking with me on this Gavin. I really appreciate your help. I'll try and figure this out tonight.

Cheers,

Robert

 

[rccline]

Sub Test Macro ()
Stops with Eror 91
"Object veriable or With block variable not set.

 

[Gavona]

Can you perform the excercise without code - always a good idea to try that way as far as poss. Record yourself doing it then refine the recorded code to achieve exactly what you want. It will also help you to understand what the code is doing.
(I recorded once using relative references and once using absolute. Then chose the best bits)

The code runs for me but there is one bug to resolve:
Change:
ActiveCell.Offset(1, 0).Range("D1:G60000").Select
to
ActiveCell.Offset(1, 0).Range("A160000").Select

or you could have used:
Range("D1:G60000").Select

(I chose relative addressing so the code was slightly more generic and easier to maintain. If your data starts at D3 you only have to change the code on one line.)

Next time you run the code choose to step through it and when you hit an error choose debug rather than stop. You will be able to watch what is happening and see which line is failing. That should help us or you to resolve the problem.

Once we have helped you to get the code working and understand what it is doing I am sure I, or other folk on the site, will help you to further refine it if needed.

Thanks,

Gavin