View Single Post
 
Old 06-11-2015, 08:46 PM
excelledsoftware excelledsoftware is offline Windows 8 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

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.
Reply With Quote