Problems with ForEach Row Function

Dylan2685

New Member
Joined
Apr 18, 2013
Messages
3
Hi & thanks for taking the time to click on my post.

As the title suggests I'm having some issues with the ForEach row function.

In an attempt to automate our company's extremely painful payroll function, i'm trying to create a function that will scrape a spreadsheet, as below, and for each Pay Code Column with an amount, output a line to csv file in the format of,
ECode,PCode,PValue

eg, for:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Employee name[/TD]
[TD]Employee Code[/TD]
[TD]Base Wage[/TD]
[TD]PayCode1[/TD]
[TD]PayCode2[/TD]
[TD]PayCode3[/TD]
[/TR]
[TR]
[TD]Test Employee1[/TD]
[TD]TEST1[/TD]
[TD]400[/TD]
[TD]250[/TD]
[TD][/TD]
[TD]38[/TD]
[/TR]
[TR]
[TD]Test Employee 2[/TD]
[TD]TEST2[/TD]
[TD]250[/TD]
[TD][/TD]
[TD]182[/TD]
[TD]45[/TD]
[/TR]
</tbody>[/TABLE]









I am hoping to eventually end up with:
TEST1,PayCode1,250
TEST1,PayCode3,38
TEST2,PayCode2,182
TEST2,PayCode3,45

I have tried to think through the logic and hoped I might be able to accomplish this with a ForEach Row Function, the underlying logic being:

FOR EACH ROW :SAVE EMPLOYEE CODE as VARIABLE1


FOR EACH COLUMN: SAVE COLUMN HEADING AS VARIABLE2


IF COLUMN HEADING CONTAINS DATA CHECK CELL


IF CELL CONTAINS DATA

WRITE LINE TO CSV : VARIABLE1,VARIABLE2,CELLCONTENTS

I hadn't quite figured out check each column heading yet, and was just starting to get the basics hashed out to save the variables if the cell contains data, however it seems that it keeps looping around over the same cell and doesn't progress any further. Am I missing something or is the entire premise flawed?

Any help would be greatly appreciated.

VB code:
Sub Process()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim ECode As String
Dim PCode As String
Dim PValue As Integer
Dim CellAdd As Range


Set rng = Range("B2:R15")


'move to first row of actual data
Range("B2").Select




For Each row In rng.Rows
'Move the cursor to Employee Code column'
Cells(ActiveCell.row, 2).Select
'Set employee code as variable
ECode = ActiveCell.Value
Cells(ActiveCell.row, 4).Select
For Each cell In row.Cells
'If cell is numeric save as variable PValue, scrape column header & save as variable PCode
If IsNumeric(ActiveCell) Then
PValue = ActiveCell.Value
Cells(1, ActiveCell.Column).Select
PCode = ActiveCell.Value
Range("A9").Value = ECode
Range("B9").Value = PCode
Range("C9").Value = PValue
End If

Next cell
Next row
End Sub
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Dylan2685,

Welcome to MrExcel.

I would imagine that you have used a recorded macro as the basis for your code? There is absolutely nothing wrong with that, it is often a good way to get code started. However, because recorded code records everything you do, it is very specific and not always efficient nor flexible.
Eg, recorded code will contain every selection you make whilst recording. When you run the macro again it may not be necessary to have those selections take place.

Typically,
Code:
'Move the cursor to a cell
Cells("A2").Select
ECode = ActiveCell.Value

can be replaced by
Code:
ECode = Cells("A2")

The main reason that your original code keeps repeating for the same cell is because of your references to the ActiveCell. Once your code gets as far as selecting D1 (PayCode1) D1 is the active cell. Beyond that, you dont select any other cells and all your code references when setting your variables are relative to D1. Your ActiveCell references can be changed to reference the 'cell' that you are already looping with.
There are lots of ways you could code to get your desired result. Below, is a cleaned up version of your original which hopefully gets you on the right track. I assume that the resultant data is in the A9:A?? range just for testing purposes?

If you run my code on your small sample data set you should get the result as below.
Excel 2007
ABCDEF
TEST1PayCode1
TEST1PayCode3
TEST2PayCode2
TEST2PayCode3
TEST1,PayCode1,250
TEST1,PayCode3,38
TEST2,PayCode2,182
TEST2,PayCode3,45

<COLGROUP><COL><COL><COL><COL><COL><COL><COL></COLGROUP><THEAD>
</THEAD><TBODY>
[TD="align: center"]1[/TD]
[TD="bgcolor: #ffffff"]Employee name[/TD]
[TD="bgcolor: #ffffff"]Employee Code[/TD]
[TD="bgcolor: #ffffff"]Base Wage[/TD]
[TD="bgcolor: #ffffff"]PayCode1[/TD]
[TD="bgcolor: #ffffff"]PayCode2[/TD]
[TD="bgcolor: #ffffff"]PayCode3[/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #ffffff"]Test Employee1[/TD]
[TD="bgcolor: #ffffff"]TEST1[/TD]
[TD="bgcolor: #ffffff"]400[/TD]
[TD="bgcolor: #ffffff"]250[/TD]
[TD="bgcolor: #ffffff"][/TD]
[TD="bgcolor: #ffffff"]38[/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #ffffff"]Test Employee 2[/TD]
[TD="bgcolor: #ffffff"]TEST2[/TD]
[TD="bgcolor: #ffffff"]250[/TD]
[TD="bgcolor: #ffffff"][/TD]
[TD="bgcolor: #ffffff"]182[/TD]
[TD="bgcolor: #ffffff"]45[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]

[TD="align: right"]250[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]10[/TD]

[TD="align: right"]38[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]

[TD="align: right"]182[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]12[/TD]

[TD="align: right"]45[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]14[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]15[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]16[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]17[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</TBODY>
Sheet1




Code:
Sub Process()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim ECode As String
Dim PCode As String
Dim PValue As Integer
Dim CellAdd As Range
Set rng = Range("B2:R15")
r = 0  'row counter for results
For Each row In rng.Rows
'Set employee code as variable
ECode = Cells(row.row, 2)
For Each cell In row.Cells
'If cell beyond column C (3)
'If cell is numeric save as variable PValue, scrape column header & save as variable PCode
If cell.Column > 3 Then
If cell > 0 Then 
PValue = cell.Value
PCode = Cells(1, cell.Column).Value
Range("A9").Offset(r, 0).Value = ECode
Range("B9").Offset(r, 0).Value = PCode
Range("C9").Offset(r, 0).Value = PValue

'Concatonate as comma delim if required
Range("A15").Offset(r, 0).Value = ECode & "," & PCode & "," & PValue
r = r + 1
End If
End If
Next cell
Next row
End Sub

Hope that helps.
 
Last edited:
Upvote 0
Tony, you, are fracking awesome & have undoubtedly saved me hours of smashing my head against the keyboard.

I've almost got this entirely sorted now and I'm only having one small error left.

I'm trying to get the code to run the 'for each' for a list of worksheets in a specific cell in one of the worksheets, however I'm getting a 'Next without For' error when I try and run the macro. I've tried running the separate code as a sub process under the if statement, however it seemed to have issues with keep track of the row counter.

Without the if if statement under the "For each sheet.." it starts but seems to get stuck in an infinite loop.

Code:
Sub Process()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim sheet_name As Range
Dim ECode As String
Dim PCode As String
Dim PValue As Double




Set rng = Range("B2:R15")
r = 0  'row counter for results


'complete the process below for each worksheet mentioned in the list in worksheet "Stores"
For Each sheet_name In Sheets("Stores").Range("A:A")
    If sheet_name.Value = "" Then
        Exit For
    Else




For Each row In rng.Rows
'Set employee code as variable
ECode = Cells(row.row, 2)
For Each cell In row.Cells
'If cell beyond column C (3)
'If cell is numeric save as variable PValue, scrape column header & save as variable PCode
If cell.Column > 3 Then
If cell > 0 Then
PValue = cell.Value
PCode = Cells(1, cell.Column).Value


'save variables into worksheet "Output"
With Sheets("Output")


    Sheets("Output").Range("A1").Offset(r, 0).Value = ECode
    Sheets("Output").Range("B1").Offset(r, 0).Value = PCode
    Sheets("Output").Range("C1").Offset(r, 0).Value = PValue


End With


r = r + 1
End If
End If


Next cell
Next row
Next ws


End Sub


Thanks again for all your help
 
Upvote 0
Dylan2685,

The code below should, hopefully, do what you want.
I have added some additional comments to the code by way of explanation.

Rich (BB code):
Sub Process()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim sheet_name As Range
Dim ECode As String
Dim PCode As String
Dim PValue As Double

r = 0  'row counter for results

'complete the process below for each worksheet mentioned in the list in worksheet "Stores"
For Each sheet_name In Sheets("Stores").Range("A:A")
    If sheet_name.Value = "" Then
        Exit For
    Else
'Because you are varying the sheets compared to the previous code working
'just within the active sheet, you must qualify the sheet and range not just range
'rng must be set for each sheet in loop so needed moving down into loop
Set rng = Sheets(sheet_name.Value).Range("B2:R15")
For Each row In rng.Rows  'nb row & cell are ok because they relate to rng
'Set employee code as variable
ECode = Sheets(sheet_name.Value).Cells(row.row, 2)
For Each cell In row.Cells
'If cell beyond column C (3)
'If cell is numeric save as variable PValue, scrape column header & save as variable PCode
If cell.Column > 3 Then
If cell > 0 Then
PValue = cell.Value
PCode = Sheets(sheet_name.Value).Cells(1, cell.Column).Value
'save variables into worksheet "Output"
With Sheets("Output")
    .Range("A1").Offset(r, 0).Value = ECode 'using with so no need to repeat Sheets("Output")
   .Range("B1").Offset(r, 0).Value = PCode 'but must use leading .
    .Range("C1").Offset(r, 0).Value = PValue
End With
r = r + 1
End If
End If
Next cell
Next row
End If 'this was missing
Next sheet_name  'you had Next ws !!!!!
End Sub

I think that's about it.
Hope that sorts it.
 
Last edited:
Upvote 0
Hi Tony, your code was perfect.

I tried several examples of looping through worksheets & I obviously forgot to tidy up the reference to 'ws' before I posted the code.

In the end I had to modify the 'If cell > 0 Then' to 'If Not IsEmpty(cell) Then' to allow for negative variables, however your help allowed me to get this project ready for implementation far quicker than I'd hoped.

If you PM your PayPal account i'd be happy to buy you a Coffee / Beer!

Thanks Again.
 
Upvote 0
Dylan2685,

I'm pleaded that it worked ok.
The thanks are appreciated but the Coffee/Beer are not necessary!
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top