Anyone know how to write the description in red below: Thanks!
Sub HC()
Dim UName As String
Dim ce As Range
Application.DisplayAlerts = False
If Application.UserName = "Blah Blah Blah" Then 'BEGIN IF #1
UName = InputBox("Please Enter Your Name")
Else
UName = Application.UserName
End If 'END IF #1
'Following code sets status to Pending
For Each ce In Range("include")
If ce = "x" Then 'BEGIN IF #2
ce.Offset(, 6).Font.ColorIndex = 11
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Pending"
End If 'END IF #2
Next ce
'End of "Pending" code
'Following code sets status to Updating
For Each ce In Range("include")
If ce = "x" Then 'BEGIN #3 (MAIN IF)
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Updating"
'End of "Updating" code
Application.ScreenUpdating = False 'turns off screen updating (user cannot see changes being made)
'Following code looks for and opens file based on File name listed
Dim MyPath As String
Dim wbname As String
Dim shname As String
Dim MyRegion As String
Dim MyFolder As String
MyPath = ThisWorkbook.Path
MyRegion = ce.Offset(, -3)
MyFolder = ce.Offset(, -1)
shname = ce.Offset(, -4)
wbname = shname
Application.AskToUpdateLinks = False
Dim Filetest As String
Filetest = Dir(MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname)
If Filetest = "" Then 'BEGIN IF #4
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = True
Application.ScreenUpdating = True
ce.Offset(, 6).Value = "File not Found"
Application.ScreenUpdating = False
Else 'ELSE #4
If WorkbookIsOpen(wbname) = False Then 'BEGIN IF #5
Workbooks.Open Filename:=MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname, UpdateLinks:=False
'NEED CODE HERE TO SELECT SHEET ("Sheet1") FIND VALUES IN COLUMN L THAT MATCH CE.OFFSET(,1). On Sheet 1, COPY COLUMNS D:G OF MATCHING ROWS ONLY TO WORKBOOK "Test" on Sheet "Sheet2" STATING IN CELL D32.
'Start code to set status to Completed
Sheets("MACRO").Activate
Application.ScreenUpdating = True
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 0
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Completed"
'End Completed code
Workbooks(shname).Activate
Workbooks(shname).Close SaveChanges:=True
End If 'End #5
End If 'END #4
'End open file code
End If 'END #3
Next ce
End Sub
Function WorkbookIsOpen(wbname) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbname)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
End If
End Function
Sub HC()
Dim UName As String
Dim ce As Range
Application.DisplayAlerts = False
If Application.UserName = "Blah Blah Blah" Then 'BEGIN IF #1
UName = InputBox("Please Enter Your Name")
Else
UName = Application.UserName
End If 'END IF #1
'Following code sets status to Pending
For Each ce In Range("include")
If ce = "x" Then 'BEGIN IF #2
ce.Offset(, 6).Font.ColorIndex = 11
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Pending"
End If 'END IF #2
Next ce
'End of "Pending" code
'Following code sets status to Updating
For Each ce In Range("include")
If ce = "x" Then 'BEGIN #3 (MAIN IF)
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Updating"
'End of "Updating" code
Application.ScreenUpdating = False 'turns off screen updating (user cannot see changes being made)
'Following code looks for and opens file based on File name listed
Dim MyPath As String
Dim wbname As String
Dim shname As String
Dim MyRegion As String
Dim MyFolder As String
MyPath = ThisWorkbook.Path
MyRegion = ce.Offset(, -3)
MyFolder = ce.Offset(, -1)
shname = ce.Offset(, -4)
wbname = shname
Application.AskToUpdateLinks = False
Dim Filetest As String
Filetest = Dir(MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname)
If Filetest = "" Then 'BEGIN IF #4
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 3
ce.Offset(, 6).Font.Bold = True
Application.ScreenUpdating = True
ce.Offset(, 6).Value = "File not Found"
Application.ScreenUpdating = False
Else 'ELSE #4
If WorkbookIsOpen(wbname) = False Then 'BEGIN IF #5
Workbooks.Open Filename:=MyPath & "\" & MyFolder & "\" & MyRegion & "\" & shname, UpdateLinks:=False
'NEED CODE HERE TO SELECT SHEET ("Sheet1") FIND VALUES IN COLUMN L THAT MATCH CE.OFFSET(,1). On Sheet 1, COPY COLUMNS D:G OF MATCHING ROWS ONLY TO WORKBOOK "Test" on Sheet "Sheet2" STATING IN CELL D32.
'Start code to set status to Completed
Sheets("MACRO").Activate
Application.ScreenUpdating = True
ce.Offset(, 4).Value = Now
ce.Offset(, 5).Value = UName
ce.Offset(, 6).Font.ColorIndex = 0
ce.Offset(, 6).Font.Bold = False
ce.Offset(, 6).Value = "Completed"
'End Completed code
Workbooks(shname).Activate
Workbooks(shname).Close SaveChanges:=True
End If 'End #5
End If 'END #4
'End open file code
End If 'END #3
Next ce
End Sub
Function WorkbookIsOpen(wbname) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbname)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
End If
End Function