Help with adding columns to a code

[keithb]

I had a code made for me years ago and I need to make a modification to it but cannot figure out how to make it work. I am not proficient in VBA.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I have spread sheets that I fill with data based on daily sales, this code pulls certain data from these sheets and places it into a master sheet.<o></o>
I need to add 2 more columns to the extraction process.<o></o>
Can someone modify this code for me?<o></o>
This would be greatly appreciated.
Keith
<o></o>
<o>Private Sub Worksheet_Activate()</o>
<o>Dim mpSheet As Worksheet
Dim mpPodium As String
Dim mpLastRow As Long
Dim mpNextRow As Long
Dim mpFormulae(1 To 9) As String
Dim i As Long, j As Long, k As Long</o>
<o>mpNextRow = 2

mpFormulae(1) = "=SUM(RC[-1]*0%,RC[-2]*3%)"
mpFormulae(2) = "=SUM(RC[-2]*0%,RC[-3]*4%)"
mpFormulae(3) = "=SUM(RC[-4] * IF(RC[-3] < 5599, 3.5%, 5.5%))"
mpFormulae(4) = "=SUM(RC[-5] * IF(RC[-4] < 5599, 3.5%, 5.5%))"
mpFormulae(5) = "=SUM(RC[-6]*.5%)"
mpFormulae(6) = "=SUM(RC[-7]*.5%)"
mpFormulae(7) = "=SUM(RC[-8]*.5%)"
mpFormulae(8) = "=SUM(RC[-9]*.0%)"
mpFormulae(9) = "=SUM(RC[-10]*.0%)"</o>
<o>mpLastRow = Me.Cells(Me.Rows.Count, "L").End(xlUp).Row
Me.Range("A2").Resize(mpLastRow, 20).ClearContents
Me.Range("A2").Value = Date

For Each mpSheet In Worksheets(Array( _
"Monday", "Tuesday", "Wednesday", _
"Thursday", "Friday", "Saturday", _
"Sunday"))

With mpSheet
For i = 9 To 68 Step 10

mpPodium = .Cells(i, "C").Value
For j = 2 To 8

If .Cells(i + j, "B").Value <> "" Then

.Cells(i + j, "B").Resize(, 9).Copy
Me.Cells(mpNextRow, "A").Value = .Range("I8").Value
Me.Cells(mpNextRow, "B").Value = mpPodium
Me.Cells(mpNextRow, "C").PasteSpecial Paste:=xlPasteValues
For k = 1 To 9

Me.Cells(mpNextRow, k + 11).FormulaR1C1 = mpFormulae(k)
Next k
mpNextRow = mpNextRow + 1
End If
Next j
Next i
End With

Me.Range("L2").Resize(mpNextRow - 1, 9).NumberFormat = "#,##0.00\ "

Next mpSheet
End Sub</o>
<o>
</o>
<o></o>

 

[Jerry Sullivan]

Keith,

I'm not sure I interpreted your needing to add 2 columns correctly.
It looks like the existing code copies 9 columns from each worksheet, then adds 9 columns of formulas. I assumed you want to copy 11 columns and add 11 columns of formulas. If that is right, you'll need to define what those extra 2 formulas do.

Try this and let me know if it does what you wanted.

Private Sub Worksheet_Activate()
    Dim mpSheet As Worksheet
    Dim mpPodium As String
    Dim mpLastRow As Long
    Dim mpNextRow As Long
    Dim mpFormulae(1 To 11) As String 
    Dim i As Long, j As Long, k As Long
    Application.ScreenUpdating = False 'runs faster
    mpNextRow = 2
 
    mpFormulae(1) = "=SUM(RC[-1]*0%,RC[-2]*3%)"
    mpFormulae(2) = "=SUM(RC[-2]*0%,RC[-3]*4%)"
    mpFormulae(3) = "=SUM(RC[-4] * IF(RC[-3] < 5599, 3.5%, 5.5%))"
    mpFormulae(4) = "=SUM(RC[-5] * IF(RC[-4] < 5599, 3.5%, 5.5%))"
    mpFormulae(5) = "=SUM(RC[-6]*.5%)"
    mpFormulae(6) = "=SUM(RC[-7]*.5%)"
    mpFormulae(7) = "=SUM(RC[-8]*.5%)"
    mpFormulae(8) = "=SUM(RC[-9]*.0%)"
    mpFormulae(9) = "=SUM(RC[-10]*.0%)"
   mpFormulae(10) = "=SUM(RC[-11]*.0%)" 'revise formulae
    mpFormulae(11) = "=SUM(RC[-12]*.0%)" 'revise formulae
    mpLastRow = Me.Cells(Me.Rows.Count, "L").End(xlUp).row
    Me.Range("A2").Resize(mpLastRow, 24).ClearContents 'edit 20->24
    Me.Range("A2").value = Date
 
    For Each mpSheet In Worksheets(Array( _
        "Monday", "Tuesday", "Wednesday", _
        "Thursday", "Friday", "Saturday", _
        "Sunday"))
 
        With mpSheet
            For i = 9 To 68 Step 10
                mpPodium = .Cells(i, "C").value
                For j = 2 To 8
                    If .Cells(i + j, "B").value <> "" Then
                        .Cells(i + j, "B").Resize(, 11).Copy 
                        Me.Cells(mpNextRow, "A").value = .Range("I8").value
                        Me.Cells(mpNextRow, "B").value = mpPodium
                        Me.Cells(mpNextRow, "C").PasteSpecial Paste:=xlPasteValues
                        For k = 1 To 11
                            Me.Cells(mpNextRow, k + 13).FormulaR1C1 = mpFormulae(k) 
                        Next k
                        mpNextRow = mpNextRow + 1
                    End If
                Next j
            Next i
        End With
        Me.Range("N2").Resize(mpNextRow - 1, 11).NumberFormat = "#,##0.00\ " 
    Next mpSheet
End Sub

 

[keithb]

Thank you so much JS411, I think I can make it work from here.

Thanks again Keithb