VBA Private Sub Application for IF Statement

Pinaceous

Pinaceous

Well-known Member
Joined
Jun 11, 2014
Messages
1,113
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I'm working on a private sub that will perform upon an If Statement.

Where I'm working with Column H & I over Range("H11:I180").

Right now, if I have :

VBA Code: 
If Range("H11") = "Enter Tally" And Range("I11") = "" Then

'Clear contents of both of these cells.

End If


I'm looking to clear the contents of both of these cells if this condition comes up and to apply its code over the range for both of these columns H&I.

Please let me know, if you can help.

Thank you!
Pinaceous
 
Sort by date Sort by votes
Since it appears the testing window is still open, & I am bored, I came up with another approach.

This approach doesn't use arrays and doesn't use looping either:

VBA Code: 
Sub Test2()
'
    Dim ColumnOffset        As Long
    Dim HelperColumnNumber  As Long, TallyColumnNumber  As Long
    Dim EndRow              As Long, StartRow           As Long
'
    EndRow = 180                                                                                ' <--- Set this to the last row to check
    StartRow = 11                                                                               ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                       ' <--- Set this to the column # of the Column with 'TALLY'
'
    HelperColumnNumber = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1    ' Find first empty column at end of data
    ColumnOffset = HelperColumnNumber - TallyColumnNumber                                       ' Calculate the # of columns offsetting TallyColumn
'                                                                                               '       from HelperColumn
    With Range(Cells(StartRow, HelperColumnNumber), Cells(EndRow, HelperColumnNumber))
        .FormulaR1C1 = "=IF(AND(RC[-" & ColumnOffset & "] = ""TALLY"", RC[-" & _
                ColumnOffset - 1 & "] <> """"), """", 1)"                                       ' Apply formula to helper column to determine which
'                                                                                               '       cells in the TallyColumn need to be blanked
    End With
'
    With Range(Cells(StartRow, TallyColumnNumber), Cells(EndRow, TallyColumnNumber))
        .Value = Evaluate("if(" & .Offset(, ColumnOffset).Address & "<> 1," & _
                .Address & ","""")")                                                            ' If HelperColumn cell = 1 then set TallyColumn cell = ""
    End With
'
    Columns(HelperColumnNumber).ClearContents                                                   ' Clear contents of the HelperColumn
End Sub

I am just starting looking into this 'No loop' approach so I am sure I probably made it harder than it had to be. Hopefully someone can respond with a more eloquent way.

I haven't done any time testing as of yet to see which way is faster. Perhaps if @Pinaceous supplies us with a bit of sample data I will test them out. I don't like making up data because it is difficult to tell how close it would resemble actual data that would be encountered.
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
OK, Still bored, so I went back through the three different versions of code we have seen thus far.

I made a few corrections/improvements along the way, Also made sure to convert them all to 'apples' so I could run a fair test on all three of the codes.

The following is what I found:
VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Sub Test_Original()                                                                         ' 0.0552044104973675 average seconds.
'
    Dim StartTime           As Double
    StartTime = MicroTimer                                                                  ' Start the stopwatch
'
    Application.ScreenUpdating = False                                                      ' Turn ScreenUpdating off
    Application.Calculation = xlCalculationManual                                           ' Turn Auto Calculation off
'
    Dim EndRow              As Long, StartRow   As Long
    Dim i                   As Long
    Dim TallyColumnNumber   As Long
'
    EndRow = 180                                                                            ' <--- Set this to the last row to check
    StartRow = 11                                                                           ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                   ' <--- Set this to the column # of the Column with 'TALLY'
'
    For i = StartRow To EndRow                                                              ' Loop through rows of data on sheet
        If Cells(i, TallyColumnNumber) = "Enter Tally" And Cells(i, TallyColumnNumber + 1) _
                = "" Then Cells(i, TallyColumnNumber).ClearContents                         '   If condition met, clear the contents of TallyColumn cell
    Next                                                                                    ' Loop back
'
    Application.Calculation = xlCalculationAutomatic                                        ' Turn Auto Calculation back on
    Application.ScreenUpdating = True                                                       ' Turn ScreenUpdating back on
'
    Debug.Print "Time elapsed = " & (MicroTimer - StartTime) & " seconds."                  ' Display Elapsed Time into Immediate Window (CTRL+G)
'
    MsgBox "Completed"                                                                      ' Signify end of program
End Sub

Public Function MicroTimer() As Double                                                      ' Precision depends on the frequency of the CPU in the computer
'
' Code by Charles Williams originally
' Uses Windows API calls to the high resolution timer
' Returns time in seconds
'
    Dim cyTicks1        As Currency
    Static cyFrequency  As Currency
'
    MicroTimer = 0                                                                          ' Initialize MicroTimer to zero
'
    If cyFrequency = 0 Then getFrequency cyFrequency                                        ' Get ticks/second aka frequency
'
    getTickCount cyTicks1                                                                   ' Get # of ticks
'
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency                                 ' Calculate seconds ... seconds = Ticks/Frequency
End Function

VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Sub Test()                                                                                  ' 0.0201938026075481 average seconds.
'
    Dim StartTime           As Double
    StartTime = MicroTimer                                                                  ' Start the stopwatch
'
    Application.ScreenUpdating = False                                                      ' Turn ScreenUpdating off
    Application.Calculation = xlCalculationManual                                           ' Turn Auto Calculation off
'
    Dim ArrayRow            As Long
    Dim EndRow              As Long, StartRow           As Long
    Dim LoopCount           As Long
    Dim TallyColumnNumber   As Long
    Dim InputArray          As Variant, OutputArray()   As Variant
'
    EndRow = 180                                                                            ' <--- Set this to the last row to check
    StartRow = 11                                                                           ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                   ' <--- Set this to column # of the Column with 'Enter Tally'
'
    InputArray = Range(Cells(StartRow, TallyColumnNumber), _
            Cells(EndRow, TallyColumnNumber + 1)).Value                                     ' Save Data from sheet into InputArray
    ReDim OutputArray(1 To UBound(InputArray, 1), 1 To UBound(InputArray, 2))               ' Set OutputArray to same # of rows & columns of InputArray
'
    ArrayRow = 0                                                                            ' Initialize ArrayRow
'
    For LoopCount = StartRow To EndRow                                                      ' Loop through InputArray rows
        ArrayRow = ArrayRow + 1                                                             '   Increment ArrayRow
'
        If InputArray(ArrayRow, 1) = "Enter Tally" And InputArray(ArrayRow, 2) = "" Then    '   If condition met then do nothing because slots already blank
''            OutputArray(ArrayRow, 1) = ""
''            OutputArray(ArrayRow, 2) = ""
        Else                                                                                '   Else ...
            OutputArray(ArrayRow, 1) = InputArray(ArrayRow, 1)                              '       Save InputArray slot to OutputArray slot
            OutputArray(ArrayRow, 2) = InputArray(ArrayRow, 2)                              '       Save InputArray slot to OutputArray slot
        End If
    Next                                                                                    ' Loop back
'
    Range("H" & StartRow & ":I" & EndRow) = OutputArray                                     ' Display OutputArray to sheet
'
    Application.Calculation = xlCalculationAutomatic                                        ' Turn Auto Calculation back on
    Application.ScreenUpdating = True                                                       ' Turn ScreenUpdating back on
'
    Debug.Print "Time elapsed = " & (MicroTimer - StartTime) & " seconds."                  ' Display Elapsed Time into Immediate Window (CTRL+G)
'
    MsgBox "Completed"                                                                      ' Signify end of program
End Sub

Public Function MicroTimer() As Double                                                      ' Precision depends on the frequency of the CPU in the computer
'
' Code by Charles Williams originally
' Uses Windows API calls to the high resolution timer
' Returns time in seconds
'
    Dim cyTicks1        As Currency
    Static cyFrequency  As Currency
'
    MicroTimer = 0                                                                          ' Initialize MicroTimer to zero
'
    If cyFrequency = 0 Then getFrequency cyFrequency                                        ' Get ticks/second aka frequency
'
    getTickCount cyTicks1                                                                   ' Get # of ticks
'
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency                                 ' Calculate seconds ... seconds = Ticks/Frequency
End Function

VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Sub Test2()                                                                                     ' 0.0158332225507678 average seconds.
'
    Dim StartTime           As Double
    StartTime = MicroTimer                                                                      ' Start the stopwatch
'
    Application.ScreenUpdating = False                                                          ' Turn ScreenUpdating off
    Application.Calculation = xlCalculationManual                                               ' Turn Auto Calculation off
'
    Dim ColumnOffset        As Long
    Dim HelperColumnNumber  As Long, TallyColumnNumber  As Long
    Dim EndRow              As Long, StartRow           As Long
'
    EndRow = 180                                                                                ' <--- Set this to the last row to check
    StartRow = 11                                                                               ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                       ' <--- Set this to the column # of the Column with 'TALLY'
'
    HelperColumnNumber = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1    ' Find first empty column at end of data
    ColumnOffset = HelperColumnNumber - TallyColumnNumber                                       ' Calculate the # of columns offsetting TallyColumn
'                                                                                               '       from HelperColumn
    With Range(Cells(StartRow, HelperColumnNumber), Cells(EndRow, HelperColumnNumber))
        .FormulaR1C1 = "=IF(AND(RC[-" & ColumnOffset & "] = ""Enter Tally"", RC[-" & _
                ColumnOffset - 1 & "] <> """"), """", 1)"                                       ' Apply formula to helper column to determine which
'                                                                                               '       cells in the TallyColumn need to be blanked
    End With
'
    With Range(Cells(StartRow, TallyColumnNumber), Cells(EndRow, TallyColumnNumber))
        .Value = Evaluate("if(" & .Offset(, ColumnOffset).Address & "<> 1," & _
                .Address & ","""")")                                                            ' If HelperColumn cell = 1 then set TallyColumn cell = ""
    End With
'
    Columns(HelperColumnNumber).ClearContents                                                   ' Clear contents of the HelperColumn
'
    Application.Calculation = xlCalculationAutomatic                                            ' Turn Auto Calculation back on
    Application.ScreenUpdating = True                                                           ' Turn ScreenUpdating back on
'
    Debug.Print "Time elapsed = " & (MicroTimer - StartTime) & " seconds."                      ' Display Elapsed Time into Immediate Window (CTRL+G)
'
    MsgBox "Completed"                                                                          ' Signify end of program
End Sub

Public Function MicroTimer() As Double                                                      ' Precision depends on the frequency of the CPU in the computer
'
' Code by Charles Williams originally
' Uses Windows API calls to the high resolution timer
' Returns time in seconds
'
    Dim cyTicks1        As Currency
    Static cyFrequency  As Currency
'
    MicroTimer = 0                                                                              ' Initialize MicroTimer to zero
'
    If cyFrequency = 0 Then getFrequency cyFrequency                                            ' Get ticks/second aka frequency
'
    getTickCount cyTicks1                                                                       ' Get # of ticks
'
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency                                     ' Calculate seconds ... seconds = Ticks/Frequency
End Function

I was actually surprised that even with this limited range of cells being tested (340) that I could 'see' a difference in the speed of the different approaches taken.

Results found:
Approach: Regular Loop through cells on the sheet = 0.0552044104973675 average seconds for the 340 cells that were checked.
Approach: Arrays with a loop = 0.0201938026075481 average seconds. 2.73 times faster than the original sheet looping approach
Approach: NoLoop & NoArrays = 0.0158332225507678 average seconds. 3.49 times faster than the original sheet looping approach

These testing results (Time wise) are not that significant in the narrow range that was tested, but if it was a larger range being tested, I am sure the benefits would be greater appreciated. ;)
 
Upvote 0
Hey johnnyL!

In using your 3rd code below:

VBA Code: 
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If

Sub Test2()                                                                                     ' 0.0158332225507678 average seconds.
'
    Dim StartTime           As Double
    StartTime = MicroTimer                                                                      ' Start the stopwatch
'
    Application.ScreenUpdating = False                                                          ' Turn ScreenUpdating off
    Application.Calculation = xlCalculationManual                                               ' Turn Auto Calculation off
'
    Dim ColumnOffset        As Long
    Dim HelperColumnNumber  As Long, TallyColumnNumber  As Long
    Dim EndRow              As Long, StartRow           As Long
'
    EndRow = 180                                                                                ' <--- Set this to the last row to check
    StartRow = 11                                                                               ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                       ' <--- Set this to the column # of the Column with 'TALLY'
'
    HelperColumnNumber = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1    ' Find first empty column at end of data
    ColumnOffset = HelperColumnNumber - TallyColumnNumber                                       ' Calculate the # of columns offsetting TallyColumn
'                                                                                               '       from HelperColumn
    With Range(Cells(StartRow, HelperColumnNumber), Cells(EndRow, HelperColumnNumber))
        .FormulaR1C1 = "=IF(AND(RC[-" & ColumnOffset & "] = ""Enter Tally"", RC[-" & _
                ColumnOffset - 1 & "] <> """"), """", 1)"                                       ' Apply formula to helper column to determine which
'                                                                                               '       cells in the TallyColumn need to be blanked
    End With
'
    With Range(Cells(StartRow, TallyColumnNumber), Cells(EndRow, TallyColumnNumber))
        .Value = Evaluate("if(" & .Offset(, ColumnOffset).Address & "<> 1," & _
                .Address & ","""")")                                                            ' If HelperColumn cell = 1 then set TallyColumn cell = ""
    End With
'
    Columns(HelperColumnNumber).ClearContents                                                   ' Clear contents of the HelperColumn
'
    Application.Calculation = xlCalculationAutomatic                                            ' Turn Auto Calculation back on
    Application.ScreenUpdating = True                                                           ' Turn ScreenUpdating back on
'
    Debug.Print "Time elapsed = " & (MicroTimer - StartTime) & " seconds."                      ' Display Elapsed Time into Immediate Window (CTRL+G)
'
    MsgBox "Completed"                                                                          ' Signify end of program
End Sub

Public Function MicroTimer() As Double                                                      ' Precision depends on the frequency of the CPU in the computer
'
' Code by Charles Williams originally
' Uses Windows API calls to the high resolution timer
' Returns time in seconds
'
    Dim cyTicks1        As Currency
    Static cyFrequency  As Currency
'
    MicroTimer = 0                                                                              ' Initialize MicroTimer to zero
'
    If cyFrequency = 0 Then getFrequency cyFrequency                                            ' Get ticks/second aka frequency
'
    getTickCount cyTicks1                                                                       ' Get # of ticks
'
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency                                     ' Calculate seconds ... seconds = Ticks/Frequency
End Function

In using your 3rd code, I was testing it out and found that it adds a value to both Column K & I from Range 11:180?

Is there anyway that you can remove this part from happening?

Also, if i use this code, that you posted above, is this the fastest one?

Can you revise your code to not use a Column Helper?

Thank you!
pinaceous
 
Upvote 0
johnnyL said:
Since it appears the testing window is still open, & I am bored, I came up with another approach.

This approach doesn't use arrays and doesn't use looping either:

VBA Code: 
Sub Test2()
'
    Dim ColumnOffset        As Long
    Dim HelperColumnNumber  As Long, TallyColumnNumber  As Long
    Dim EndRow              As Long, StartRow           As Long
'
    EndRow = 180                                                                                ' <--- Set this to the last row to check
    StartRow = 11                                                                               ' <--- Set this to the start row to check
    TallyColumnNumber = 8                                                                       ' <--- Set this to the column # of the Column with 'TALLY'
'
    HelperColumnNumber = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1    ' Find first empty column at end of data
    ColumnOffset = HelperColumnNumber - TallyColumnNumber                                       ' Calculate the # of columns offsetting TallyColumn
'                                                                                               '       from HelperColumn
    With Range(Cells(StartRow, HelperColumnNumber), Cells(EndRow, HelperColumnNumber))
        .FormulaR1C1 = "=IF(AND(RC[-" & ColumnOffset & "] = ""TALLY"", RC[-" & _
                ColumnOffset - 1 & "] <> """"), """", 1)"                                       ' Apply formula to helper column to determine which
'                                                                                               '       cells in the TallyColumn need to be blanked
    End With
'
    With Range(Cells(StartRow, TallyColumnNumber), Cells(EndRow, TallyColumnNumber))
        .Value = Evaluate("if(" & .Offset(, ColumnOffset).Address & "<> 1," & _
                .Address & ","""")")                                                            ' If HelperColumn cell = 1 then set TallyColumn cell = ""
    End With
'
    Columns(HelperColumnNumber).ClearContents                                                   ' Clear contents of the HelperColumn
End Sub

I am just starting looking into this 'No loop' approach so I am sure I probably made it harder than it had to be. Hopefully someone can respond with a more eloquent way.

I haven't done any time testing as of yet to see which way is faster. Perhaps if @Pinaceous supplies us with a bit of sample data I will test them out. I don't like making up data because it is difficult to tell how close it would resemble actual data that would be encountered.
Click to expand...

In supplying a sample data piece, the user would only be able to change one of these cells represented here by the image of H12, H14, H16, H17, & H18 at a time single time and and not all at the same time.

Therefore, I would want your code to act on the cells of H12, H14, H16, H17, & H18 represented here, theoretically.
 

Attachments

  • Capture.PNG
    Capture.PNG
    10.6 KB · Views: 3
Upvote 0
Pinaceous said:
In using your 3rd code, I was testing it out and found that it adds a value to both Column K & I from Range 11:180?

Is there anyway that you can remove this part from happening?
Click to expand...

Not sure what you mean by that. Can you post a pic that shows what you are referring to?

Pinaceous said:
Also, if i use this code, that you posted above, is this the fastest one?
Click to expand...

I posted the timed results for the codes that I tested. I also mentioned that if you provided a sample of data, I could perhaps give better timing results.
 
Upvote 0
Here is a sample of the adding of values that it adds values to my column K and L. Here I was testing out your code from using added values into H11 & I11.
 

Attachments

  • Capturesd.jpg
    Capturesd.jpg
    128.9 KB · Views: 1
Upvote 0
I have a few questions.

I am not sure how the code I provided writes '1s' to both columns of K & L

The code I provided cleans up after itself, in other words, there should be be no remnance of it's existents to begin with.

Can you provide a link to a workbook where I can see/replicate what you are talking about?

If you don't like what that version of code is doing, you can always use the array approach. That approach was only slightly slower.

I would like to address your issues with the code that you mentioned though.
 
Upvote 0
Solution
Hey johnnyL!

I found my error, it was not your code!

Many thanks for supplying me a super great code!

Keep up the great work!

Respectfully,
pinaceous
 
Upvote 0
Are you sure? If not, let me know and we can address this.

Otherwise, Glad to help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
Code for rows of cells returning reverse-order values.
Replies
5
Views
211
Worksong
W
P
  • Question
Excel to internal application
Replies
2
Views
217
pure vito
P
Pinaceous
  • Solved
VBA If statement
Replies
3
Views
260
My Aswer Is This
My Aswer Is This
Pinaceous
  • Question
vba capitalize 1st letter of each word then exit sub after correction
Replies
3
Views
286
Alex Blakenburg
A
G
  • Question
Macro Code Help for multiple worksheets.
Replies
1
Views
222
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,085
Messages
6,128,732
Members
449,465
Latest member
TAKLAM

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top