arrays, vbe automation learning...
hello ...i was hoping i could get some feedback on these procs...as i am teaching myself...they both work fine...just wondering if i missed a better way...or am wasting memory rescources...i used variant arrays..and i did not declare [lower To] upper [,[lower To] upper] in re dimming the arrays asuming option base 0 default...i appriciate any feedback....
----------------------------------------
for example ArrayDemo3....Range R4:T6 =
1 2 3
4 5 6
7 8 9
Code:
Sub ArrayDemo3()
'LOAD AN ARRAY FROM ANOTHER ARRAY
Dim MyArray As Variant
Dim xArray As Variant
Dim el As Variant
Dim i As Integer
ReDim MyArray(2, 0)
ReDim xArray(2)
' xArray = Range("$R$4:$R$6").Value
xArray = Range("$R$4:$T$4").Value
i = 0
For Each el In xArray
MyArray(i, 0) = el
i = i + 1
Next el
ReDim Preserve MyArray(2, 1)
' xArray = Range("$S$4:$S$6").Value
xArray = Range("$R$5:$T$5").Value
i = 0
For Each el In xArray
MyArray(i, 1) = el
i = i + 1
Next el
ReDim Preserve MyArray(2, 2)
' xArray = Range("$T$4:$T$6").Value
xArray = Range("$R$6:$T$6").Value
i = 0
For Each el In xArray
MyArray(i, 2) = el
i = i + 1
Next el
For Each el In MyArray
MsgBox el
Next
End Sub
Code:
Sub PTS_Procedure(xModName As String, xProcNameFullLine As String)
'PINTS A PROCEDURE TO A WORKSHEET...
'xModName = MODULE NAME
'xProcNameFullLine = THE PROCEDURE NAME, AS IT APPEARS ON THE CODE LINE
Dim fTarget As String 'PROC TO PRINT
Dim fsLine As Long 'FIND START LINE
Dim fsColumn As Long 'FIND START COLUMN
Dim feLine As Long 'FIND END LINE
Dim feColumn As Long 'FIND END COLUMN
Dim pName As String 'PROC NAME
Dim pType As Long 'PROC TYPE
Dim psLine As Long 'PROC START LINE
Dim pbLine As Long 'PROC BODY LINE
Dim pcLines As Long 'PROC COUNT OF LINES
Dim ptsLines As Long 'PRINT TO SHEET LINES
Dim cArray As Variant 'CODE ARRAY
Dim i As Integer
Dim xRange As String 'SHEET RANGE
Dim XMN As VBComponent
Set XMN = Application.VBE.ActiveVBProject.VBComponents(xModName)
'INNITIALIZE ARGUMENTS
fTarget = xProcNameFullLine
fsLine = 1
fsColumn = 1
feLine = XMN.CodeModule.CountOfLines
feColumn = Len(XMN.CodeModule.Lines(XMN.CodeModule.CountOfLines, 1))
'FIND THE PROC
If XMN.CodeModule.Find(fTarget, fsLine, fsColumn, feLine, feColumn, True, True) Then
'GET PROC DETAILS
With XMN.CodeModule
pName = .ProcOfLine(fsLine, pType) 'RETURNS RECOGNIZED NAME AND TYPE
psLine = .ProcStartLine(pName, pType)
pbLine = .ProcBodyLine(pName, pType)
pcLines = .ProcCountLines(pName, pType)
End With
'GET LINES OF BODY
ptsLines = pcLines - (pbLine - psLine)
'LOAD AN ARRAY WITH PROC
ReDim cArray(ptsLines - 1, 0)
Do Until i = ptsLines
cArray(i, 0) = XMN.CodeModule.Lines(pbLine + i, 1)
i = i + 1
Loop
'WRITE TO SHEET
xRange = "A3" & ":" & "A" & UBound(cArray) + 3 'YA COULD USE ptsLines - 1...
Range(xRange) = cArray
Else
MsgBox "Can't Find Procedure"
End If
Set XMN = Nothing
End Sub