I have been given the task of fixing a macro that has been written by somebody else.
The macro is supposed to search the worksheets within the wb for certain data types extract this information then transfer it to a table.
As it stands when I run the macro it appears to search through all the worksheets then does nothing.
I would greatly appreciate it if somebody could tell me what this macro is actually doing.
There is also a second macro which appears to do nothing at all.
Macro 1
Sub Macro1()
'
' Macro1 Macro
'
'
Dim matrixFMECA() As String
ReDim matrixFMECA(2000, 16 * 3 + 1)
'the counter in matrixFMECA is in 0 0
matrixFMECA(0, 0) = 0
For i = 1 To ActiveWorkbook.Sheets.Count
Dim matrixFMECAInit As Integer
matrixFMECAInit = matrixFMECA(0, 0)
Sheets(i).Select
matrixFMECA = Macro2(matrixFMECA)
For j = matrixFMECAInit To matrixFMECA(0, 0)
' matrixFMECA(j,16*3+1) will be the page in which the component is located
' matrixFMECA(j,16*3) will be the row in which the component is located
matrixFMECA(j, 16 * 3 + 1) = i
Next j
Next i
Debug.Print "finish"
End Sub
Function Macro2(ByVal matrixFMECA As Variant)
Dim rowBeginEnd As Integer
On Error GoTo 1:
Cells.Find(What:="Item No.:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
rowBeginEnd = ActiveCell.Row
Cells.FindNext(After:=ActiveCell).Activate
While rowBeginEnd <> ActiveCell.Row
matrixFMECA(0, 0) = matrixFMECA(0, 0) + 1
Debug.Print (ActiveCell)
' matrixFMECA(1, 1) = ActiveCell.Text
For j = 0 To 2
For i = 0 To 15
matrixFMECA(matrixFMECA(0, 0), i + j * 16) = Cells(ActiveCell.Row - 2 + j, ActiveCell.Column + i)
Next i
Next j
'this is the location of the component.
matrixFMECA(matrixFMECA(0, 0), 3 * 16) = ActiveCell.Row
Range(ActiveCell, Cells(ActiveCell.Row - 2, ActiveCell.Column + 14)).Select
Dim rememberCellContinuation As Range
'rememberCellContinuation = ActiveCell.Range.Address
'Cells.Find(What:="Item No.:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Cells(ActiveCell.Row + 2, ActiveCell.Column).Activate
Cells.FindNext(After:=ActiveCell).Activate
'MATRIXSETUP next one
Wend
'Repeat the loop one more time
matrixFMECA(0, 0) = matrixFMECA(0, 0) + 1
Debug.Print (ActiveCell)
' matrixFMECA(1, 1) = ActiveCell.Text
For j = 0 To 2
For i = 0 To 15
matrixFMECA(matrixFMECA(0, 0), i + j * 16) = Cells(ActiveCell.Row - 2 + j, ActiveCell.Column + i)
Next i
Next j
'this is the location of the component.
matrixFMECA(matrixFMECA(0, 0), 3 * 16) = ActiveCell.Row
Range(ActiveCell, Cells(ActiveCell.Row - 2, ActiveCell.Column + 14)).Select
Cells(ActiveCell.Row + 2, ActiveCell.Column).Activate
Macro2 = matrixFMECA
1:
Macro2 = matrixFMECA
End Function
Macro 2
Sub Macro3()
'
' Macro3 Macro
'
'
Dim matrixFMES() As String
ReDim matrixFMES(2000, 2000, 10)
'the counter in matrixFMECA is in 0 0 0
matrixFMES(0, 0, 0) = 0
For i = 1 To ActiveWorkbook.Sheets.Count
Dim matrixFMESInit As Integer
matrixFMESInit = matrixFMES(0, 0, 0)
Sheets(i).Select
matrixFMES = getFMES(matrixFMES)
Next i
Debug.Print "finish"
End Sub
Function getFMES(ByVal matrixFMES As Variant)
On Error GoTo 1:
Cells.Find(What:="FMES Code(s)", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Dim StudyColumn As Integer
StudyColumn = ActiveCell.Column
For j = 1 To 1000
If (Cells(j, StudyColumn) <> "") Then
Dim positionFound As Integer
positionFound = -1
Dim positionExit As Integer
For k = 1 To UBound(matrixFMES, 1)
If matrixFMES(k, 0, 0) = "" Then
positionExit = k
k = UBound(matrixFMES, 1)
ElseIf matrixFMES(k, 1, 1) = Cells(j, StudyColumn) Then
matrixFMES(k, 0, 0) = matrixFMES(k, 0, 0) + 1
'now add info to matrixFMES(k,matrixFMES(k,0,0), 1..2...3...4...10 )
positionFound = k
End If
Next k
If positionFound < 0 Then
Debug.Print Cells(j, StudyColumn)
matrixFMES(positionExit, 1, 1) = Cells(j, StudyColumn)
matrixFMES(positionExit, 0, 0) = 1
End If
End If
Next
getFMES = matrixFMES
1:
getFMES = matrixFMES
End Function
Bookmarks