Excel VBA - multiply cells and move

Seamus2626
Seamus2626 used Ask the Experts™
on

Hi,

I have attached a SS where i need some vba code that will multiply the entries that are not blank in column F by -1 so to make them positive and them copy them over to column G

There could be 20 entries on the Spreadsheet or 200, it varies

Can anyone suggest any code?

Thanks
Seamus
SS1.zip
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Sub ChangeNeg()
i = 1
Do Until Cells(i, 1).Value = ""

If Cells(i, 7).Value = "" Then
    Cells(i, 7).Value = Cells(i, 6).Value * (-1)
    Else
End If
i = i + 1
Loop
End Sub
Kyle AbrahamsSenior .Net Developer

Commented:
Attached.
Sub Macro1()
'
' Macro1 Macro
'

'
Dim i As Integer
i = 1

While Cells(i, 1).Value <> ""
    If Cells(i, "F").Value < 0 Then
        Cells(i, "G").Value = Cells(i, "F").Value * -1
    End If
    i = i + 1
   
Wend
    
    
End Sub

Open in new window

Author

Commented:
Sorry guys i should have added that the button is in another tab and the sheet where i need the above changes made is called "CODA EOD"

Can you alter the code so that it looks in the sheet "CODA EOD" and then performs the above

Thanks
Seamus
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Sub ChangeNeg()
Sheets("CODA EOD").Select
i = 1
Do Until Cells(i, 1).Value = ""

If Cells(i, 7).Value = "" Then
    Cells(i, 7).Value = Cells(i, 6).Value * (-1)
    Else
End If
i = i + 1
Loop
End Sub

Author

Commented:
Perfect!! Thanks KnutsonBM!

Thank you too ged325

Cheers,
Seamus

Sub makePos()
Dim sh As Worksheet
Set sh = Sheets("CODA EOD")
For i = 2 To sh.UsedRange.Rows.Count
    If IsNumeric(sh.Range("F" & i).Value) Then
        sh.Range("G" & i).Value = sh.Range("F" & i).Value * -1
    End If
Next
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial