Problems with ForEach Row Function

[Dylan2685]

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:

Employee name	Employee Code	Base Wage	PayCode1	PayCode2	PayCode3
Test Employee1	TEST1	400	250		38
Test Employee 2	TEST2	250		182	45

<tbody>
</tbody>

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

 

[Snakehips]

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,

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

can be replaced by

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

	A	B	C	D	E	F
1	Employee name	Employee Code	Base Wage	PayCode1	PayCode2	PayCode3
2	Test Employee1	TEST1	400	250		38
3	Test Employee 2	TEST2	250		182	45
4
5
6
7
8
9	TEST1	PayCode1	250
10	TEST1	PayCode3	38
11	TEST2	PayCode2	182
12	TEST2	PayCode3	45
13
14
15	TEST1,PayCode1,250
16	TEST1,PayCode3,38
17	TEST2,PayCode2,182
18	TEST2,PayCode3,45

<COLGROUP><COL><COL><COL><COL><COL><COL><COL></COLGROUP><THEAD>
</THEAD><TBODY>
</TBODY>

Sheet1​

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.

 

[Dylan2685]

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.

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

 

[Snakehips]

Dylan2685,

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

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.

 

[Dylan2685]

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.

 

[Snakehips]

Dylan2685,

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