Still new to VBA and need help modifying some existing code.
Several IF statements need to occur in the new code: If copied font is green, paste as values and change font color from green to blue. If copied font is anything other than green, paste as formulas.
Sub InvestorModelMacro()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False
Dim r As Range, ws As Worksheet
For Each r In Worksheets("Asset Dashboard").Range("C6:C9") 'go through each cell in DV list
If Len(r) > 0 Then 'only do something if cell not empty
Worksheets("Live").Range("D3").Value = r.Value 'transfer value to cell D3 of 'Live' tab
Application.Calculate
Set ws = Worksheets.Add 'add new sheet
ws.Name = Worksheets("Investor Model").Range("D3") 'renames new sheet after selected asset
Worksheets("Investor Model").Cells.Copy
ws.Range("A1").PasteSpecial xlValues 'copy values only from Investor Model to new sheet
ws.Range("A1").PasteSpecial xlFormats 'copy formats only from Investor Model to new sheet
ActiveWindow.DisplayGridlines = False 'turns off gridlines
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Unfortunately, the code below is still returning formulas for all cells pasted into new worksheets. I need the green font to be pasted as values, and all other font colors to remain as formulas...
Sub InvestorModelMacro()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DisplayGridlines = False
Dim r As Range, ws As Worksheet
For Each r In Worksheets("Asset Dashboard").Range("C6:C9") 'go through each cell in DV list
If Len(r) > 0 Then 'only do something if cell not empty
Worksheets("Live").Range("D3").Value = r.Value 'transfer value to cell D3 of 'Live' tab
Application.Calculate
Set ws = Worksheets.Add 'add new sheet
ws.Name = Worksheets("Investor Model").Range("D3") 'renames new sheet after selected asset
If r.Font.Color = RGB(0, 153, 0) Then
r.Copy
Range("A1").PasteSpecial xlPasteValues
Range("A1").Font.Color = RGB(0, 153, 0)
Else
r.Copy
Range("A1").PasteSpecial xlPasteFormulas
Range("A1").Font.Color = RGB(0, 0, 255)
End If
Worksheets("Investor Model").Cells.Copy
ws.Range("A1").PasteSpecial xlFormulas 'copy values only from Investor Model to new sheet
ws.Range("A1").PasteSpecial xlFormats 'copy formats only from Investor Model to new sheet
ActiveWindow.DisplayGridlines = False 'turns off gridlines
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub