Use Excel Macros to Loop through worksheet and process data

wzheng

New Member
Joined
May 18, 2018
Messages
2
Hello All,

I am new to this forum and I am hoping some one can help me out in this matter.
What I like to achieve is:

- Loop through a worksheet row by row
- Based on an index value, copy the selected row multiple times and then split the cost by percentage assigned
- Write the result to a new worksheet
- Go back to the previous worksheet and go to the next row and process all over again based on the index

Basically this is to do a wage split for different divisions for a finance statement. The index is stored a the first column of the work sheet. Depending on the coding of index, I need to copy multiple times of the selected row depending on how many divisions the wage cost needs to split it into and then add another line to balance the total split amount to the original department.

I know this sounds a bit complex. So I copy the previous and after to help understand what my goal is:

Previous:
Div AccountAmount Employee IDEmployee Name Account Description Description Journal Description
737605001882776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
73760500246.752776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
737605307.522776 Employee 1HOLIDAY PAYRise BW 08Rise BW 08-2776
737605309.872776 Employee 1HOLIDAY PAYRise BW 09Rise BW 09-2776

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col></colgroup>
After processing (Goal)


IndexDiv AccountAmount Employee IDEmployee Name Account Description Description Journal Description
AA737605001882776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
AA22360500188*0.12776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
AA71560500188*0.252776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
AA80260500188*0.152776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
AA73760500-942776 Employee 1OTHER SALARIESRise BW 08Rise BW 08-2776
AA73760500246.752776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
AA22360500246.75*0.12776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
AA71560500246.75*0.252776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
AA80260500246.75*0.152776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
AA73760500-123.3752776 Employee 1OTHER SALARIESRise BW 09Rise BW 09-2776
<colgroup><col width="64" style="width: 48pt;" span="2"> <col width="115" style="width: 86pt; mso-width-source: userset; mso-width-alt: 4205;"> <col width="244" style="width: 183pt; mso-width-source: userset; mso-width-alt: 8923;"> <col width="64" style="width: 48pt;"> <col width="159" style="width: 119pt; mso-width-source: userset; mso-width-alt: 5814;"> <col width="64" style="width: 48pt;" span="2"> <col width="155" style="width: 116pt; mso-width-source: userset; mso-width-alt: 5668;"> <tbody> </tbody>

Sorry for all these numbers but I just want to help understand the issue. Can this be done in Excel macro? If it can be done, can some one give me suggestions on how to start coding?

I know this involved a loop and if statement. Perhaps a basic structure to loop through each row embedded with an if statement is a good start. It is a bit too complex at this point to put my hands on. Please help! Thank you!

Wenny Z
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Tinbendr

Well-known Member
Joined
Jul 21, 2010
Messages
997
This seems to work.
Code:
Sub Breakout()
Dim WS As Worksheet
Dim NewWB As Workbook
Dim A As Long
Dim LastRow As Long
Dim LR As Long

Set WS = Worksheets(1)

With WS
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row

    If LastRow > 1 Then
        Set NewWB = Workbooks.Add
        'Copy the headers
        WS.Range("A1:I1").Copy NewWB.Sheets(1).Range("A1")
        
        LR = 2
        For A = 2 To LastRow
            If .Range("A" & A) = "AA" Then
                WS.Range("A" & A & ":I" & A).Copy
                NewWB.Sheets(1).Range("a" & LR & ":I" & LR + 5).PasteSpecial xlPasteAll
                NewWB.Sheets(1).Range("B" & LR + 1) = "220"
                NewWB.Sheets(1).Range("D" & LR + 1) = NewWB.Sheets(1).Range("D" & LR) * 0.1
                NewWB.Sheets(1).Range("B" & LR + 2) = "713"
                NewWB.Sheets(1).Range("D" & LR + 2) = NewWB.Sheets(1).Range("D" & LR) * 0.25
                NewWB.Sheets(1).Range("B" & LR + 3) = "802"
                NewWB.Sheets(1).Range("D" & LR + 3) = NewWB.Sheets(1).Range("D" & LR) * 0.15
                NewWB.Sheets(1).Range("D" & LR + 4) = _
                    (NewWB.Sheets(1).Range("D" & LR) * 0.1 + _
                    NewWB.Sheets(1).Range("D" & LR) * 0.25 + _
                    NewWB.Sheets(1).Range("D" & LR) * 0.15) * -1
                LR = LR + 5
            End If
        Next
    End If
End With


End Sub
 

wzheng

New Member
Joined
May 18, 2018
Messages
2
Hi David,

Thank you very much for your posting. It seems it only returns the header of the column though.

Wenny Z

This seems to work.
Code:
Sub Breakout()
Dim WS As Worksheet
Dim NewWB As Workbook
Dim A As Long
Dim LastRow As Long
Dim LR As Long

Set WS = Worksheets(1)

With WS
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row

    If LastRow > 1 Then
        Set NewWB = Workbooks.Add
        'Copy the headers
        WS.Range("A1:I1").Copy NewWB.Sheets(1).Range("A1")
        
        LR = 2
        For A = 2 To LastRow
            If .Range("A" & A) = "AA" Then
                WS.Range("A" & A & ":I" & A).Copy
                NewWB.Sheets(1).Range("a" & LR & ":I" & LR + 5).PasteSpecial xlPasteAll
                NewWB.Sheets(1).Range("B" & LR + 1) = "220"
                NewWB.Sheets(1).Range("D" & LR + 1) = NewWB.Sheets(1).Range("D" & LR) * 0.1
                NewWB.Sheets(1).Range("B" & LR + 2) = "713"
                NewWB.Sheets(1).Range("D" & LR + 2) = NewWB.Sheets(1).Range("D" & LR) * 0.25
                NewWB.Sheets(1).Range("B" & LR + 3) = "802"
                NewWB.Sheets(1).Range("D" & LR + 3) = NewWB.Sheets(1).Range("D" & LR) * 0.15
                NewWB.Sheets(1).Range("D" & LR + 4) = _
                    (NewWB.Sheets(1).Range("D" & LR) * 0.1 + _
                    NewWB.Sheets(1).Range("D" & LR) * 0.25 + _
                    NewWB.Sheets(1).Range("D" & LR) * 0.15) * -1
                LR = LR + 5
            End If
        Next
    End If
End With


End Sub
 

Forum statistics

Threads
1,148,294
Messages
5,745,944
Members
423,985
Latest member
sayed manzar

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
Top