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




Reply With Quote