Insert formulas in VBA code

excelledsoftware · #14 06-11-2015, 08:46 PM

Macropod I guess my computer is really fast because it ran your code in the same amount of time as mine ran, crazy. I did make a mistake on the header though revised code below once more.

Code:

Option Explicit
Sub CountTrueValues()
  'Inserts a column to the right of C and then runs
  'a countif to see how many times the phrase true
  'is entered in the columns
  
  Dim CheckRow As Long, LastRow As Long, Tot As Integer
  Dim LastCol As String, CountRange As String
  
  'Insert a column
  Range("D:D").Insert
  Range("D1").Value = "Active/Inactive"
  
  'Identify where to stop
  LastRow = Range("C2").End(xlDown).Row
  LastCol = Range("A1").End(xlToRight).Address
  LastCol = Mid(LastCol, 2) 'remove first $
  LastCol = Mid(LastCol, 1, InStr(1, LastCol, "$") - 1) 'remove the row

  'Go through the data and enter a value
  For CheckRow = 2 To LastRow
    CountRange = "E" & CheckRow & ":" & LastCol & CheckRow
    Tot = WorksheetFunction.CountIf(Range(CountRange), "true")
    Range("D" & CheckRow).Value = Tot
  Next CheckRow
  
  MsgBox "done"
  
End Sub

Now that I see the header Active/Inactive I am wondering if you just needed to check if the one of the columns had True or not. If this is the case we can make this way faster by using the following code that only took 6 seconds to run.

Code:

Sub CheckForTrueValue()
  'Inserts a column to the right of C and then runs
  'a countif to see how many times the phrase true
  'is entered in the columns
  
  Dim CheckRow As Long, LastRow As Long, CheckVal As String
  Dim CheckCol As Long, LastCol As Long
  
  'Insert a column
  Range("D:D").Insert
  Range("D1").Value = "Active/Inactive"
  
  'Identify where to stop
  LastRow = Range("C2").End(xlDown).Row
  LastCol = Range("A1").End(xlToRight).Column

  'Go through the data and enter a 1
  For CheckRow = 2 To LastRow
    For CheckCol = 5 To LastCol
      CheckVal = Cells(CheckRow, CheckCol).Value
      If UCase(CheckVal) = "TRUE" Then
        Range("D" & CheckRow).Value = 1
        Exit For
      End If
    Next CheckCol
  Next CheckRow
  
  MsgBox "done"
  
End Sub

Please let us know if any of these workout for you.

Thanks to Macropod, NoSparks and CharlesDH for their help.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA code for Microsoft Word macro — select text and insert footnote	ndnd	Word VBA	10	01-06-2015 01:47 PM
Help with IF or ELSE Formulas	tsaladyga	Excel	4	07-23-2014 09:04 AM
Search and replace/insert HTML code into Master File using tags	dave8555	Excel	2	02-23-2014 03:51 PM
Need help with formulas please	paul_pearson	Excel	0	03-20-2013 06:51 AM
IF Formulas	mizzamzz	Excel	1	07-08-2010 02:32 AM