Macro to check value, open file, copy value, loop through range.

[Ctomo]

Hi Guys,

I'm getting better at VBA but i feel like I've come to a stand still due to my knowledge and experience.

I am trying to create a "Order Tracker" to check status's of orders. So, at the moment, as the file names are infinite and the value "to get" are in different cells based on what file they are opening, but i digress.

I need a macro that will look in a range (% of order status, range K9 down) then if that value is not 100% (or 1) then open the file location which is based in column AV adjacent to the status %. Then to copy the adjacent value in AU (this is a indirect formula to grab the status from that file once opened) into the appropriate K cell as a VALUE.

I have a Macro which HALF works. I started simply by setting a range but i am pretty i have gone about this the wrong way. Does anyone have any advice?

Sub OpenNotComplete()

   Dim myRange As Range
   Dim i As Long, j As Long
   Set myRange = Range("K9:K11")
   For i = 1 To myRange.Rows.Count
      For j = 1 To myRange.Columns.Count
   
       If myRange.Cells(i, j).Value < 1 Then
     
        ActiveCell.Offset(0, 47).Select   'selects file location from cell
        Dim wrkMyWorkBook As Workbook
        Set wrkMyWorkBook = Workbooks.Open(Filename:=ActiveCell.Value)
        
        Windows("Order Tracker.xlsm").Activate
        
        ActiveCell.Offset(1, -47).Select  'goes back to original cell
        myRange.Cells(i, j).Font.ColorIndex = 3 'change all orders less than 100% to red
       Else
       myRange.Cells(i, j).Font.ColorIndex = 1 'change all complete orders to black
         End If
      Next j
      
   Next i

   MsgBox "Complete"
End Sub

[mdmackillop]

Can you post sample files? use Go Advanced/Manage Attachments

[mdmackillop]

Untested

Sub OpenNotComplete()
    Dim wrkMyWorkBook As Workbook
    Dim myRange As Range
    Dim i As Long, j As Long, f As String, x
    Set myRange = Range("K9:K11")
    With myRange
    For i = 1 To .Rows.Count
            If .Cells(i).Value < 1 Then f = .Cells(i).Offset(0, 47)
                Set wrkMyWorkBook = Workbooks.Open(Filename:=f)
                x = Sheets("Sheet1").Cells(i, "AU")   '<==   Fix sheet name
                wrkMyWorkBook.Close False
                .Cells(i) = x
                .Cells(i).Font.ColorIndex = 3 'change all orders less than 100% to red
            Else
                .Cells(i).Font.ColorIndex = 1 'change all complete orders to black
            End If
    Next i
    MsgBox "Complete"
End Sub

[mdmackillop]

The code here demonstrates how to pull data from a closed workbook which looks a better solution to your question

[Ctomo]

Thanks Buddy! All up and running. Legend.