MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.
Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.
Private Sub CommandButton1_Click() 'This Code adds verification to a color coded book. Dim rCell As Range Dim N As Single Dim vr As Range Dim i As Long Dim NowCount As String Dim aColor As Long ' Data entry for random number (Light Blue) Dim bColor As Long ' Data entry for words - set by cell defined name (Very Pale Blue) Dim cColor As Long ' Verification data that shouldn't be changed but should be removed prior to issue (Tan) Dim dColor As Long ' Data/Formulas that shouldn't be changed or removed prior to issue (Very Pale Green) Dim DefaultName As String Dim DefaultNameValue As Integer Randomize ' Initiate random number generator aColor = RGB(153, 204, 255) 'Specify the color range for random numbers bColor = RGB(204, 255, 255) cColor = RGB(255, 204, 153) dColor = RGB(204, 255, 204) DefaultName = "CellNeedsName" DefaultNameNumber = 1 'Add the random numbers For N = 1 To Sheets.count For Each rCell In Sheets(N).UsedRange If rCell.Interior.Color = aColor Then rCell.Value = 0.6 + (0.3 * Rnd) Else End If Next rCell Next N 'Add the cell names For N = 1 To Sheets.count For Each rCell In Sheets(N).UsedRange If rCell.Interior.Color = bColor Then If IsError(rCell.Name.Name) = False Then rCell.Value = rCell.Name.Name Else rCell = DefaultName & DefaultNameValue DefaultNameValue = DefaultNameValue + 1 End If Else End If Next rCell Next N 'Sets up verification sheet i = 2 Set vr = Verification.Range("A:D") For N = 1 To Sheets.count NowCount = "" If Sheets(N).Name = "Verification" Then Else i = i + 1 Sheets(N).Activate vr.Cells(i, 1).Value = Sheets(N).Name For Each rCell In Sheets(N).Cells.SpecialCells(xlCellTypeFormulas) 'looks for NOW formula and removes them from the equation If rCell.Formula = "=NOW()" Then NowCount = NowCount & "-Sum('" & ActiveSheet.Name & "'!" & rCell.Address(0, 0) & ")" Next vr.Cells(i, 2).Value = "=Sum('" & ActiveSheet.Name & "'!" & ActiveSheet.UsedRange.Address(0, 0) & ")" & NowCount ' vr.Cells(i, 3).Value = NowCount vr.Cells(i, 4).Value = vr.Cells(i, 2).Value End If Next N 'ActiveCell.FormulaR1C1 Verification.Activate End Sub
|How to Get a Count of Unique Values and paste them on a different tab||3||17|
|Excel formula to return X:Y axis in a cell||6||24|
|populate some cells after data verification||45||18|