Batch Processing Macro

[ryguy7272]

I am trying to come up with a batch processing macro that opens each excel
file in a folder, checks all cells in Column I, and if they are not blank,
inserts something like this into Cells (adjacent to the non-blank cells) in
Column J:
=IF(E2<>"",F2,IF(G2<>"",H2))


Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'your macro that does the work goes
For Each C In Range("I2:I100")
If C.Value <> "" Then
ActiveCell.Offset C.Value = "=IF(E2<>"",F2,IF(G2<>"",H2))"
Next C

tempWkbk.Close savechanges:=True

Next fCtr

End If

End Sub


I am having problems with the Loop: For Each C…Next C.

Also, I don’t necessarily want the macro to loop from I2:I100; if some of
those cells are blank I want Excel to stop working on that Worksheet and
start working on the next Workbook. There must be some syntax to cause the
macro to perform an operation only in a Used range, or only if cells are
<>â€â€. Does anyone know how to set this up?

Regards,
Ryan---

 

[Gary Keramidas]

maybe something like this may help. it's untested. just dim lastrow as long with
your variables, then replace your code at the end with this and give it a try.

'your macro that does the work goes
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
For Each c In Range("I2:I" & lastrow)
If c.Value <> "" Then
c.Offset(, 1).Value = "=IF(E" & c.Row & "<>" & """" & ",F" & c.Row & ",IF(G" & _
c.Row & "<>" & """" & ",H" & c.Row & "))"
Next c

tempWkbk.Close savechanges:=True

Next fCtr

 

[ryguy7272]

Thanks Gary. The requirements changes just slightly. I'm trying to test for
blanks in Column H, and if there is not a blank, perform a simple math
operation: =IF(H2<>"",H2*V2)

My code:

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "H").End(xlUp).Row
For Each c In Range("H2:H" & lastrow)
If c.Value <> "" Then
c.Offset(, 18).Value = "=IF(H" & c.Row & "<>" & """" & ",H" & c.Row &
"*V" & c.Row & "))"
Next c
tempWkbk.Close savechanges:=True

Next fCtr
End If

End Sub

When it runs it produces a next without for error, and focus goes to this
line:
Next c
(5 up from the bottom)

Can someone please o\point out my error?

 

[ryguy7272]

Here is my code now:
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
Next c

'Columns("B:B").Select
'Selection.Insert Shift:=xlToRight
tempWkbk.Close savechanges:=True
Next fCtr

I keep getting a Next Without For error. this line seems to be the culprit:
Next c

Not sure why though...

Sorry Gary, I recorded a macro and got a slightly different value
(requirements changed) as seen above. It just seemed easier to use this than
to use the value that you sent to me.

 

[T Lavedas]

Here is my code now:
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
Next c

'Columns("B:B").Select
'Selection.Insert Shift:=xlToRight
tempWkbk.Close savechanges:=True
Next fCtr

I keep getting a Next Without For error. this line seems to be the culprit:
Next c

Not sure why though...

Sorry Gary, I recorded a macro and got a slightly different value
(requirements changed) as seen above. It just seemed easier to use this than
to use the value that you sent to me.

The IF block within the innermost FOR is not closed.

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
end if
Next c

Indenting helps avoid such problems.

Tom Lavedas
===========
http://members.cox.net/tglbatch/wsh/

 

[ryguy7272]

Thanks T Lavedas! The code looks tight, but the still seems to be a problem
somewhere. I can't see it. Can you see the issue? The error is here:
For Each c In Range("F2:F" & lastrow)

Message is:
Method Range of object_Global Failed

Code is:
Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Rows("1:1").Select
Selection.Font.Bold = True

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
End If
Next c
tempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

Regards,
Ryan--


--
RyGuy

Here is my code now:
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
Next c

'Columns("B:B").Select
'Selection.Insert Shift:=xlToRight
tempWkbk.Close savechanges:=True
Next fCtr

I keep getting a Next Without For error. this line seems to be the culprit:
Next c

Not sure why though...

Sorry Gary, I recorded a macro and got a slightly different value
(requirements changed) as seen above. It just seemed easier to use this than
to use the value that you sent to me.

The IF block within the innermost FOR is not closed.

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
end if
Next c

Indenting helps avoid such problems.

Tom Lavedas
===========
http://members.cox.net/tglbatch/wsh/

 

[T Lavedas]

Thanks T Lavedas! The code looks tight, but the still seems to be a problem
somewhere. I can't see it. Can you see the issue? The error is here:
For Each c In Range("F2:F" & lastrow)

Message is:
Method Range of object_Global Failed

Code is:
Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Rows("1:1").Select
Selection.Font.Bold = True

For Each c In Range("F2:F" & lastrow)

I can't find where you make the variable lastrow equal to anything.
Therefore, it is undefined, which accounts for the error you're
getting.

Tom Lavedas
===========
http://members.cox.net/tglbatch/wsh/

 

[ryguy7272]

Kind of funny, but kind of sad, that I couldn't resolve that myself. Anyway,
thanks for all of the help Tom!! Thanks to you too Gary!!

Ryan--

 

[Dave Peterson]

I'm coming late to the party, but here's another one to try:

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'what worksheet in that tempwkbk gets worked on?
'I used the first (leftmost) worksheet
With tempWkbk.Worksheets(1)
.Rows(1).Font.Bold = True
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row

For Each c In .Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).FormulaR1C1 _
= "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
End If
Next c
End With

tempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

Thanks T Lavedas! The code looks tight, but the still seems to be a problem
somewhere. I can't see it. Can you see the issue? The error is here:
For Each c In Range("F2:F" & lastrow)

Message is:
Method Range of object_Global Failed

Code is:
Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Rows("1:1").Select
Selection.Font.Bold = True

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
End If
Next c
tempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

Regards,
Ryan--

--
RyGuy

Here is my code now:
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
Next c

'Columns("B:B").Select
'Selection.Insert Shift:=xlToRight
tempWkbk.Close savechanges:=True
Next fCtr

I keep getting a Next Without For error. this line seems to be the culprit:
Next c

Not sure why though...

Sorry Gary, I recorded a macro and got a slightly different value
(requirements changed) as seen above. It just seemed easier to use this than
to use the value that you sent to me.

The IF block within the innermost FOR is not closed.

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
end if
Next c

Indenting helps avoid such problems.

Tom Lavedas
===========
http://members.cox.net/tglbatch/wsh/

 

[ryguy7272]

This works too! Thanks for everything guys!!
Ryan---

--
RyGuy

I'm coming late to the party, but here's another one to try:

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'what worksheet in that tempwkbk gets worked on?
'I used the first (leftmost) worksheet
With tempWkbk.Worksheets(1)
.Rows(1).Font.Bold = True
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row

For Each c In .Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).FormulaR1C1 _
= "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
End If
Next c
End With

tempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

Thanks T Lavedas! The code looks tight, but the still seems to be a problem
somewhere. I can't see it. Can you see the issue? The error is here:
For Each c In Range("F2:F" & lastrow)

Message is:
Method Range of object_Global Failed

Code is:
Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim lastrow As Long
Dim c As Variant

'change to point at the folder to check
myPath = "C:\Ryan"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Rows("1:1").Select
Selection.Font.Bold = True

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
End If
Next c
tempWkbk.Close savechanges:=True
Next fCtr

End If

End Sub

Regards,
Ryan--

--
RyGuy

On May 6, 1:36 pm, ryguy7272 <[email protected]>
wrote:
Here is my code now:
For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

lastrow = Cells(Rows.Count, "F").End(xlUp).Row
For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
Next c

'Columns("B:B").Select
'Selection.Insert Shift:=xlToRight
tempWkbk.Close savechanges:=True
Next fCtr

I keep getting a Next Without For error. this line seems to be the culprit:
Next c

Not sure why though...

Sorry Gary, I recorded a macro and got a slightly different value
(requirements changed) as seen above. It just seemed easier to use this than
to use the value that you sent to me.

--
RyGuy


The IF block within the innermost FOR is not closed.

For Each c In Range("F2:F" & lastrow)
If c.Value <> "" Then
c.Offset(, 20).Value = "=IF(RC[-20]<>"""",RC[-17]*RC[-3])"
end if
Next c

Indenting helps avoid such problems.

Tom Lavedas
===========
http://members.cox.net/tglbatch/wsh/