Advertisement
mukeshdak

2022-12-28-useful-vba-code

Feb 28th, 2020 (edited)
803
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 1.73 KB | Source Code | 0 0
  1. REM : This subroutine creates counting from a given cell location.
  2. Sub ginti()
  3. Dim Source As Range
  4. Set Source = Selection
  5. q = Source.Text
  6. 'Source.Value = 3
  7. 'Source.Value = 4
  8.    With Source
  9.         .Value = 1
  10.         .AutoFill .Resize(q, 1), xlFillSeries
  11.     End With
  12. End Sub
  13.  
  14. Sub mdInsulationCheck()
  15.     Dim Source As Range
  16.     Dim errFlag As Boolean
  17.     Dim errCount As Integer
  18.    ' Dim iCol As Long
  19.    Dim nCol As Long
  20.     Dim iRow As Long
  21.     Dim nRow As Long
  22.     Dim total As Double
  23.    
  24.     ' By default, there is no error.
  25.    errFlag = False
  26.     errCount = 0
  27.    
  28.     Set Source = Selection
  29.     nCol = Source.Columns.Count
  30.     nRow = Source.Rows.Count
  31.    
  32.     For iRow = 1 To nRow
  33.         x = Source.Rows(iRow).Columns(1).Address
  34.         x2 = Source.Rows(iRow).Columns(nCol).Address
  35.         sumx = Source.Rows(iRow).Columns(1 - 4).Address
  36.         sumx2 = Source.Rows(iRow).Columns(0).Address
  37.         Range(sumx & ":" & sumx2).Select
  38.         tempSum = WorksheetFunction.Product(Selection)
  39.        
  40.         For tempcol = 1 To nCol
  41.             If (Source.Rows(iRow).Columns(tempcol).Value = tempSum Or Source.Rows(iRow).Columns(tempcol).Value = "") Then
  42.             Else
  43.             errFlag = True
  44.             errCount = errCount + 1
  45.              Range(Source.Rows(iRow).Columns(tempcol).Address).Select
  46.              Selection.Interior.Color = RGB(255, 100, 100)
  47.              MsgBox "ERROR in " & Source.Rows(iRow).Columns(tempcol).Address
  48.            '  Exit Sub
  49.            End If
  50.         Next tempcol
  51.     Next iRow
  52.    
  53.     If errFlag = False Then
  54.         MsgBox "Calculation is OK"
  55.         Else
  56.         MsgBox CStr(errCount) + " Errors found", vbCritical, "Mar Gaye - Errors found."
  57.         End If
  58. End Sub
Tags: vba
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement