Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 279
  • Last Modified:

How do I include a calculation in a vba if statement

Hi Experts,

I have added a button to my excel worksheet that copies rows from another excel worksheet within the same workbook based off of the values in a column.  What I also need to add to the code is a formula that will look at the value in the corresponding row and divide itself by every cell in that row where the cell value is not null, then paste the results in the new worksheet that I created.  Please see the sample file attached.  The code that I used on the command button to copy and paste is below.
 Example.xlsx
Private Sub Button_Click()
Dim rng As Range
Dim cell As Range
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim r As Integer
r = 2
Set ws = Sheets("HighRollers")
Set ws1 = Sheets("Example")
Set rng = ws.Range("R2:R" & ws.Cells(1048576, "R").End(xlUp).row)

For Each cell In rng
If cell.Value = "Daily" Then
    cell.EntireRow.Copy Sheets("Example").Cells(r, 1)
    r = r + 1
End If
Next cell

End Sub

Open in new window

0
daintysally
Asked:
daintysally
  • 9
  • 7
  • 4
2 Solutions
 
StephenJRCommented:
What if you change the If section to this?
If cell.Value = "Daily" Then
    cell.EntireRow.Copy Sheets("Example").Cells(r, 1)
    cell.Offset(, -1).Copy
    Sheets("Example").Cells(r, 4).Resize(, 9).SpecialCells(xlCellTypeConstants) _
                    .PasteSpecial operation:=xlPasteSpecialOperationDivide
    r = r + 1
End If

Open in new window

0
 
broro183Commented:
hi,

Can you please upload the file again in a different format such as .xls, .xlsm, or .xlsb?
(.xlsx prevents any code being saved within the file)

Also, I'm having trouble understanding exactly what you want so can you please include some more explanation in the file with a "before & after" example?

Rob

__________________
Rob Brockett. Always learning & the best way to learn is to experience...
0
 
daintysallyAuthor Commented:
StephenJR,

Will ".PasteSpecial operation:=xlPasteSpecialOperationDivide " do the division like I need it to?  I will try that
   
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
daintysallyAuthor Commented:
StephenJR,
In the snippett below, can you explain your logic?

Sheets("Example").Cells(r, 4).Resize(, 9).SpecialCells(xlCellTypeConstants) _
                    .PasteSpecial operation:=xlPasteSpecialOperationDivide
0
 
StephenJRCommented:
I assumed you were wanting to divide each of the numbers you pasted by the value in column Q. Is that right? That's what it does. The special cells bit is to avoid pasting the blanks which will result in zero. Does it actually do what you want?
0
 
daintysallyAuthor Commented:
broro183,

I do not have any code within the sample that I provided.  I just pasted the code that I used in the original file.  What I provided was an example.  I want to copy all the rows from the "High Rollers" sheet where the value in column "R" is equal to "Daily".  Before I paste that information into the "Example" worksheet, I need to divide every numeric value within the row by the values contained in column Q respectively, then paste those results.
0
 
StephenJRCommented:
My code pastes the values as is and then does the division, but the result is the same.
0
 
daintysallyAuthor Commented:
StephenJR,

I modified my code to match the 'If' statement that you provided me and I get this error message: No cells were found.  
I only changed this part: "Sheets("Example").Cells(r, 4).Resize(, 9)." to "Sheets("Example").Cells(r, 8).Resize(, 9)." to fit my actual file
0
 
StephenJRCommented:
That suggests you have all blanks. I may have made a mistake. If you change to

Resize(,13)

does that work?

Can you post a sample of your actual workbook if not?
0
 
daintysallyAuthor Commented:
I don't have all blanks in the cells.  Unfortunately, I cannot post the actual file as there is sensitive information contained within it.  Please see an example of the actual file attached. Sample.xlsm
0
 
broro183Commented:
It looks like StephenJR has the solution under control. My additional thoughts are:

- Have you tried recording a macro which applies an Autofilter for "Daily" & then copies/pastes the visible cells before processing StephenJR's code?
Using an autofilter is likely to be much faster than looping cell by cell esp. as the size of the dataset increases.

- how big is your dataset?
If it is >16k rows & you use an autofilter-copy visible cells, you could be at risk of hitting the specialcells limitations in pre-2010 versions of excel.

- I suggest testing " if Not (visiblespecialcells range is nothing) then '..." before attempting to copy/divide, as this will prevent errors if no cells have been found.

- I suggest changing "Dim r as integer" to be "Dim r as Long". I believe the compiler will internally convert code to long before processing it therefore you are saving it some "work". Also, you have used
Set rng = ws.Range("R2:R" & [b]ws.Cells(1048576, "R").End(xlUp)[/b].row)

Open in new window

which means that potentially "r" could end up being larger than the upper Integer size limit of ~32k.

 
hth
Rob
__________________
Rob Brockett. Always learning & the best way to learn is to experience...
0
 
daintysallyAuthor Commented:
broro183, can you please apply your thoughts to the most recent sample file that I provided, it will help me to understand the logic better if I can step through it.
0
 
daintysallyAuthor Commented:
I hope that no one has forgotten about me.  I really need to get this done tonight.
0
 
broro183Commented:
nope, not forgotten but I should be asleep!

StephenJR,
I'll have a go, since Sally's waiting, but let me know if you're still working on it...

Rob
0
 
broro183Commented:
hi,

I do not have any code within the sample that I provided.  I just pasted the code that I used in the original file.  What I provided was an example.  I want to copy all the rows from the "High Rollers" sheet where the value in column "R" is equal to "Daily".  Before I paste that information into the "Example" worksheet, I need to divide every numeric value within the row by the values contained in column Q respectively, then paste those results.

Has column R become column AO & has column Q corespondingly become column AN in the new file?

Rob
0
 
daintysallyAuthor Commented:
Thank you broro183 for helping me out!!  Yes, column R has become column AO and column Q has become column AN.
0
 
broro183Commented:


It's not finished :( but it you may be able to combine the below with StephenJR's code...

Option Explicit
Public glb_origCalculationMode As Long


Sub Example_Button1_Click()
Dim AFrng As Range    'Autofilter Range
Dim cll As Range
Dim DataWs As Worksheet
Dim OutputWs As Worksheet
Dim r As Long
Dim FreqCol As Range
Dim MnthlySpendAmountCol As Range
Dim visrng As Range
Dim FirstBlankRow As Long
Dim Rw As Range
Dim NewLastRow As Long

    Set DataWs = Sheets("HighRollers")
    Set OutputWs = Sheets("Example")

    With DataWs
        'Set rng = .Range("AO2:AO" & .Cells(.Rows.Count, "AO").End(xlUp).Row)
        If .AutoFilterMode = False Then
        Else
            On Error Resume Next
            .ShowAllData
            On Error GoTo 0
        End If

        Set FreqCol = .Rows(1).Find(What:="Frequency", LookIn:=xlValues, LookAt:=xlWhole, after:=.Cells(1, 1))
        If FreqCol Is Nothing Then
            MsgBox "The frequency column wasn't found therefore macro exiting!", vbOKOnly, "WARNING!"
        End If

        '### not used but it could be...
        Set MnthlySpendAmountCol = .Rows(1).Find(What:="Monthly Spend Amount", LookIn:=xlValues, LookAt:=xlWhole, after:=.Cells(1, 1))
        If MnthlySpendAmountCol Is Nothing Then
            MsgBox "The monthly spend column wasn't found therefore macro exiting!", vbOKOnly, "WARNING!"
        End If

        Call ToggleRefreshApp(False)

        Set AFrng = .Range("a1:" & LastCell(DataWs).Address)
        With AFrng
            .AutoFilter Field:=FreqCol.Column, Criteria1:="Daily"
            Set visrng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
        End With

        If visrng Is Nothing Then
            MsgBox "there are no 'Daily' rows therefore macro exiting!", vbOKOnly, "WARNING!"
        End If
    End With

    With OutputWs
        FirstBlankRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        visrng.Copy Destination:=.Range("A" & FirstBlankRow)
        NewLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Each Rw In .Range("A" & FirstBlankRow).Offset(0, 7).Resize(NewLastRow - FirstBlankRow + 1, 12)
            With Rw
                ''###this doesn't yet work...
                .Value2 = .Value2 / .Resize(1, 1).Offset(0, 26).Value2
                ''try using Stephen's code here...
                '...
            End With
        Next Rw
    End With

    AFrng.AutoFilter Field:=FreqCol.Column
    Call ToggleRefreshApp(True)

    Set visrng = Nothing
    Set AFrng = Nothing
    Set DataWs = Nothing
    Set OutputWs = Nothing

End Sub


Function LastCell(ws As Worksheet) As Range
' sourced from http://www.beyondtechnology.com/geeks012.shtml
'Obj: to identify the lastcell on a worksheet (& not necessarily the active sheet)
Dim LastRow As Long
Dim LastCol As Long
    ' Error-handling is here in case there is not any
    ' data in the worksheet
    On Error Resume Next
    With ws
        ' Find the last real populated row
        LastRow = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByRows).Row
        ' Find the last real populated column
        LastCol = .Cells.Find(What:="*", _
                              SearchDirection:=xlPrevious, _
                              SearchOrder:=xlByColumns).Column
        ' Finally, initialize a Range object variable for
        ' the last populated row.
        Set LastCell = .Cells(LastRow, LastCol)
        If LastCell Is Nothing Then Set LastCell = .Cells(1, 1)
    End With
    On Error GoTo 0
End Function


Sub ToggleRefreshApp(RefreshAppSettings As Boolean)
    With Application
        If RefreshAppSettings Then
            glb_origCalculationMode = .Calculation
        End If
        .EnableEvents = RefreshAppSettings
        On Error Resume Next
        '        .Calculation = IIf(RefreshAppSettings, glb_origCalculationMode, xlCalculationManual)
        .Calculation = IIf(RefreshAppSettings, xlCalculationAutomatic, xlCalculationManual)
        On Error GoTo 0
        .StatusBar = False    'this should really be stored as a glb variable & restored, but impact in this file is minimal
        .ScreenUpdating = RefreshAppSettings
    End With
End Sub

Open in new window


hth
Rob
0
 
broro183Commented:
hi DaintySally,

Did you get the code to work?

Rob
0
 
daintysallyAuthor Commented:
Yes for the most part.  Thank you for asking.  However, I need to add some code in here that will not show the #DIV/0! when there are blanks and I need to figure out how to get the code to insert rows and not overwrite another header row that sits on row 50 of the worksheet.  Any ideas?
0
 
broro183Commented:
Can you please post the latest complete version of the code you are working with?

Rob
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

  • 9
  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now