My purpose is to split a task into constituent tasks and find the most important one.The macro is written in "May" sheet of workallotment.xlsm and the tasks are in tasks.xlsx
For example:
Constituents Constituents Important Imp
Praveen T1 T2 T3 T4 T5 T6 T1+T2+T3 =T5 T3+T5+T6 =T9 T1 T6
4 3 1 2 8 9
Karthik P1 P2 P3 P4 " among T1,T2,T3- T1 takes more time".its imp
6 3 2 2
Walter c1 c2 c3 c4
1 2 3 4
Arvind g1 g2 g3
2 1 3
Sreelatha h1 h2 h3
2 1 1
Code:
Sub workallotment()
Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet
Dim str(9) As String
Dim splitArray() As String, S(10) As String
Dim col_new As Integer
Dim wa_nameRng As Range
Dim r As Integer, max As Integer, imps As String
Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer 'work allotment rows
Dim t_firstRow, t_lastrow As Integer 'task rows
Dim curTaskCol As Integer 'current task column
Dim wa_tmpcol As Integer 'work allotment, temp column
Set workallotmentWB = ThisWorkbook
Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
'notes on data structure:
'- tasks workbook:
'first name starts in A1 of "Sheet1"
'- workallotment workbook:
'first name starts in A2 of Sheet named "workallotment"
'tasks are to be written starting in B2
'in Row 1 are headers (number of days)
t_firstRow = 1
wa_firstRow = 2
wa_nameRow = 0
Set waSheet = workallotmentWB.Worksheets("May") ' in this file - workallotment.xlsm
With tasksWB.Worksheets("May") ' in tasks.xlsx which is attached
'finding the last rows
t_lastrow = .Range("A1000000").End(xlUp).row + 1
wa_lastRow = waSheet.Range("A1000000").End(xlUp).row
'goes through all the names in tasks_Sheet1
For r = t_firstRow To t_lastrow Step 2
Set wa_nameRng = waSheet.Range("A:A").find(.Range("A" & r).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not wa_nameRng Is Nothing Then
wa_nameRow = wa_nameRng.row
curTaskCol = 2
wa_tmpcol = 2
Do While Not IsEmpty(.Cells(r, curTaskCol).Value)
For C = 1 To .Cells(r + 1, curTaskCol).Value
waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
wa_tmpcol = wa_tmpcol + 1
Next C
curTaskCol = curTaskCol + 1
Loop
End If
Next r
End With
MsgBox ("done")
For r = t_firstRow To t_lastrow Step 2 ' loop to find importance
col = 2 'setting to initial col
curTaskCol = 17 ' position input - constituent jobs at 17th col in tasks.xls
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, curTaskCol).Value)
str(curTaskCol - 16) = tasksWB.Worksheets("May").Cells(r, curTaskCol).Value
' reading input to first array of string element
substr = Left(str(curTaskCol - 16), Application.WorksheetFunction.find("=", str(curTaskCol - 16)) - 1) ' if T1+T2=T3 it'll look before "=" symbol
MsgBox (substr)
splitArray() = Split(substr, "+") ' if T1+T2 it will be split as T1 & T2
For i = LBound(splitArray) To UBound(splitArray)
S(i + 1) = splitArray(i) ' assigning split elements to string array
Next i
For i = LBound(splitArray) To UBound(splitArray)
col_new = 2 ' checking from 2nd column
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, col_new).Value)
If (S(i + 1) = tasksWB.Worksheets("May").Cells(r, col_new).Value) Then 'initialising max and imps
imps = S(i + 1) ' most important job
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
End If ' maximum time taken for task
col_new = col_new + 1
Loop
For j = LBound(splitArray) To UBound(splitArray)
col_new = findcol(S(j + 1), r, tasksWB)
If (max < tasksWB.Worksheets("May").Cells(r + 1, col_new).Value) Then
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
imps = tasksWB.Worksheets("May").Cells(r, col_new).Value
End If
Next j
Next i
tasksWB.Worksheets("May").Cells(r, curTaskCol + 6).Value = imps
' assign most IMPORTANT task on 6th column from current column
curTaskCol = curTaskCol + 1 ' RUNTIME ERROR 1004
Loop
Next r
End Sub
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer, addr As Integer
col = 2 ' checking from column 2
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
addr = col ' if task string is found in column
End If
col = col + 1 ' return column found
Loop
findcol = addr
End Function
Krishnan,
In your main proc workallotment
you declare the variable tasksWB
.
In your method 'findcol' you then reference tasksWB
. It looks like you've pulled this code out of the main proc. The tasksWB only has scope within workallot
and so you need to give findcol
this object so it will have it within it's scope as well.
I would recommend that you pass the tasksWB into the method, as a third parameter.
Your method would then look as follows.
Edit for your comment of why findcol doesn't return. The Exit Function
will ensure that the method is exited immediately after setting the return value. Without this you would end up in the asking for the correct task name again.
Public Function findcol(S As String, row As Integer, theWB as Workbook) As Integer
col = 2 ' checking from column 2
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (S = theWB.Worksheets("May").Cells(row, col).Value) Then
findcol = col ' if task string is found in column
Exit Function
End If
'MsgBox ("Enter correct task names") Not sure why this is here.
col = col + 1 ' return column found
Loop
End Function
and you'd call it with
col_new = findcol(S(j + 1), r, tasksWB) ' ERROR line function to find column of task string
This will ensure that you do not "leak" your variable definition into global scope, and that you also ensure that your method doesn't depend on external globals.
Edit 3: Your findcol is still wrong.
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer
'******* you don't need this because you can exit early
'Dim addr As Integer
col = 2 ' checking from column 2
'***** THIS LINE NEEDS TO BE REMOVED because you are using theWB being passed in *****
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
'****** this line must use theWB
'If (StrComp(Trim(S), Trim(tasksWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
'************* you can exit early once you've found what you need.
'addr = col ' if task string is found in column
findcol = col
exit function
End If
col = col + 1 ' return column found
Loop
' You can exit early so don't need this.
' findcol = addr
End Function
You should probably do a check when you call the function that the value hasn't returned 0, eg
new_col = findcol( .... )
if new_col = 0 then
msgbox "couldn't find the column with that str" & S(j + 1)
end if