mukeshdak

2023-01-01_vba_functions_custom

Nov 6th, 2021 (edited)
2,039
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub ginti()
  2. Dim Source As Range
  3. Set Source = Selection
  4. q = Source.Text
  5. 'Source.Value = 3
  6. 'Source.Value = 4
  7.    With Source
  8.         .Value = 1
  9.         .AutoFill .Resize(q, 1), xlFillSeries
  10.     End With
  11. End Sub
  12.  
  13. Sub mdInsulationCheck()
  14.     Dim Source As Range
  15.    ' Dim iCol As Long
  16.    Dim nCol As Long
  17.     Dim iRow As Long
  18.     Dim nRow As Long
  19.     Dim total As Double
  20.    
  21.     Set Source = Selection
  22.     nCol = Source.Columns.Count
  23.     nRow = Source.Rows.Count
  24.    
  25.     For iRow = 1 To nRow
  26.         x = Source.Rows(iRow).Columns(1).Address
  27.         x2 = Source.Rows(iRow).Columns(nCol).Address
  28.         sumx = Source.Rows(iRow).Columns(1 - 4).Address
  29.         sumx2 = Source.Rows(iRow).Columns(0).Address
  30.         Range(sumx & ":" & sumx2).Select
  31.         tempSum = WorksheetFunction.Product(Selection)
  32.        
  33.         For tempcol = 1 To nCol
  34.             If (Source.Rows(iRow).Columns(tempcol).Value = tempSum Or Source.Rows(iRow).Columns(tempcol).Value = "") Then
  35.             Else
  36.              Range(Source.Rows(iRow).Columns(tempcol).Address).Select
  37.              Selection.Interior.Color = RGB(255, 100, 100)
  38.              MsgBox "ERROR in " & Source.Rows(iRow).Columns(tempcol).Address
  39.              Exit Sub
  40.             End If
  41.         Next tempcol
  42.     Next iRow
  43.     MsgBox "Calculation is OK"
  44. End Sub
Advertisement
Add Comment
Please, Sign In to add comment