Return to Question

sample userform

The following function/sub are located in a regular module.

This is the OPTIMIZE_VBA Sub:

Public Sub OPTIMIZE_VBA(ByVal isOn As Boolean)
Dim bHolder As Boolean
bHolder = Not isOn
With Application
 .DisplayAlerts = bHolder
 .ScreenUpdating = bHolder
 .EnableEvents = bHolder
 .Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
 .Calculate
 If .Version > 12 Then .PrintCommunication = bHolder
End With
End Sub

This is the GET_LAST Function:

Public Function GET_LAST(c As Choice, rng As Range)
Dim o As XlSearchOrder
Dim r As Range
 o = xlByRows '<~~ default value
 If c = 2 Then o = xlByColumns '<~~ change it if looking for column
 Set r = rng.Find(What:="*", after:=rng.Cells(1), LookIn:=xlFormulas, _
 LookAt:=xlPart, SearchOrder:=o, SearchDirection:=xlPrevious, _
 MatchCase:=False)
 If r Is Nothing Then Set r = rng.Cells(1, 1) '<~~ if we found nothing give "A1"
 If c = Row Then GET_LAST = r.Row
 If c = Column Then GET_LAST = r.Column
 If c = Cell Then GET_LAST = rng.Parent.Cells(GET_LAST(Row, rng), GET_LAST(Column, rng)).Address(0, 0)
End Function

This is the CLEANARR Function:

That receives a 2D array and loops from lbound upto ubound of 1stD.

Filters the array with the given column number and criteria ('s' as string).

Public Function CLEANARR _
 (ByRef v() As Variant, ByVal s As String, ByVal c As Integer, _
 Optional ByVal RemoveMatch As Boolean = False, _
 Optional ByVal ExactMatch As Boolean = False, _
 Optional ByVal KeepHeader As Boolean = True) _
As Variant
 
Dim a(), r As Long, i1 As Long, i2 As Long
Dim StartofLoop As Integer, deleteRecord As Boolean
ReDim a(LBound(v(), 1) To UBound(v(), 1), LBound(v(), 2) To UBound(v(), 2))
StartofLoop = LBound(v(), 1)
If KeepHeader Then Call GIVE_HEADER(a(), r, StartofLoop, v())
For i1 = StartofLoop To UBound(v(), 1)
 If ExactMatch Then
 If Not (UCase(Format(v(i1, c), "0")) = UCase(Format(s, "0"))) = RemoveMatch Then deleteRecord = True
 Else
 If Not InStr(1, v(i1, c), s, vbTextCompare) = RemoveMatch Then deleteRecord = True
 End If
 
 If deleteRecord Then
 r = r + 1
 For i2 = LBound(v(), 2) To UBound(v(), 2)
 a(r, i2) = v(i1, i2)
 Next
 deleteRecord = False
 End If
Next
CLEANARR = REDUCEARR(a())
End Function

This is the TRANSPOSEARR Function:

Public Function TRANSPOSEARR(ByRef v() As Variant) As Variant
Dim rows, cols As Long
Dim s() As Variant
ReDim s(LBound(v(), 2) To UBound(v(), 2), LBound(v(), 1) To UBound(v(), 1))
For rows = LBound(v(), 1) To UBound(v(), 1)
 For cols = LBound(v(), 2) To UBound(v(), 2)
 s(cols, rows) = v(rows, cols)
 Next
Next
TRANSPOSEARR = s()
End Function

Out of the topic:

I am (somehow) aware of SQL Queries using ADO in excel, but I do not know where to start reading/studying. External references/tutorials are very much appreciated.