Advertisement
actorcat

Functions

Aug 18th, 2023
690
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Public Function NumbersToColumns(myCol As Long)
  2. Dim iA As Long, fA As Long
  3.     If myCol >= 1 And myCol <= 16384 Then
  4.         iA = Int((myCol - 1) / 26)
  5.         fA = Int(IIf(iA - 1 > 0, (iA - 1) / 26, 0))
  6.         NumbersToColumns = IIf(fA > 0, Chr(fA + 64), "") & _
  7.                         IIf(iA - fA * 26 > 0, Chr(iA - fA * 26 + 64), "") & _
  8.                         Chr(myCol - iA * 26 + 64)
  9.     Else
  10.         NumbersToColumns = False
  11.     End If
  12. End Function
  13.  
  14. Function DeleteElement(x As String, ByRef List() As String) ' As String
  15.    Dim i As Long, el As Long
  16.     Dim result() As String
  17.  
  18.     ReDim result(UBound(List) - 1)
  19.  
  20.     For i = 0 To UBound(List)
  21.         If x = List(i) Then
  22.             el = i
  23.             Exit For
  24.         End If
  25.     Next i
  26.  
  27.     For i = 0 To UBound(result)
  28.         If i < el Then
  29.             result(i) = List(i)
  30.         Else
  31.             result(i) = List(i + 1)
  32.         End If
  33.     Next i
  34.  
  35.     DeleteElement = result
  36. End Function
  37.  
  38. Function sumSkipper(target As Range, Scell As Long, Snumber As Long)
  39. 'sumskip1
  40. 'sumskip(range,starting row, rows to skip) ie.-range b1:b100, 5, 10 will add every 10th cell starting with the 5th row
  41. Dim Fnumber As Long, answer As Long, a As Long
  42. Fnumber = target.Rows.Count / Snumber
  43. For a = 1 To Fnumber
  44. answer = answer + Cells(Scell, target.Column).Value
  45. Scell = Scell + Snumber
  46. Next
  47. sumSkipper = answer
  48. End Function
  49.  
  50. Sub AddRowsToArr(arr, Optional ByVal nRows As Long = 1, Optional overwrite As Boolean = True)
  51.  
  52. 'directions:  'AddRowsToArr myArray3, 1  ---no parenthesis
  53.  
  54. 'define arrays of needed row and column numbers
  55.    Dim r, C
  56.     r = Evaluate("row(1:" & CStr(nRows + UBound(arr) - LBound(arr) + 1) & ")")
  57.     C = Application.Transpose(Evaluate("row(1:" & CStr(UBound(arr, 1) - LBound(arr, 1) + 1) & ")"))
  58.     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  59.    'redimension array to new size
  60.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  61.    arr = Application.Index(arr, r, C)
  62.  
  63.     '*) optional overwriting added row elements with Empty ~~> see Note below!
  64.    '...
  65. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement