PDA

View Full Version : Macro to check value, open file, copy value, loop through range.



Ctomo
07-11-2016, 01:58 AM
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
07-11-2016, 02:32 AM
Can you post sample files? use Go Advanced/Manage Attachments

mdmackillop
07-11-2016, 02:53 AM
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
07-11-2016, 01:01 PM
The code here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=454) demonstrates how to pull data from a closed workbook which looks a better solution to your question

Ctomo
07-13-2016, 03:05 AM
Thanks Buddy! All up and running. Legend.