Use Excel Macros to Loop through worksheet and process data

W

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

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.
Sort by date Sort by votes
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
 
Upvote 0
Hi David,

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

Wenny Z

Tinbendr said:
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
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
excel macro to split data into multiple worksheets based on conditions worksheet
Replies
4
Views
4K
Fluff
Fluff
L
  • Question
VBA - Consolidate data and Sum mulitiple ranges
Replies
1
Views
1K
MickG
M
Y
  • Question
Macro to copy values across rows and transposing them and add the user id
2
Replies
17
Views
2K
DanteAmor
DanteAmor
P
  • Question
Copying data from one col. to another
Replies
6
Views
476
Panoos64
P
K
  • Question
Macros to build Income statements
Replies
2
Views
837
Kazdima
K

Forum statistics

Threads
1,214,875
Messages
6,122,040
Members
449,063
Latest member
ak94

Share this page

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