Reproduce formula in sequence

JamieDuncan

JamieDuncan

Board Regular
Joined
Aug 23, 2006
Messages
132
I am trying to reproduce formulae over a couple thousand rows, unfortunately there are gaps but the formulae must remain sequential,
this is the basic recorded macro to cut copy the data as it is needed but i would like a macro that can start from any active cell (being the top left cell of the first range) as i have to repeat this procedure over several sheets (first sheet took 4 hours!)
Tried using integers but got myself in a kerfuffle! :oops:
Help me! :cry:

Code: 
Sub Macro1()
    Range("A13:M29").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O21").Select
    Application.CutCopyMode = False
    Range("O21:AA37").Cut Destination:=Range("O50:AA66")
    Range("O50:AA66").Select
    Selection.Copy
    Range("A50").Select
    ActiveSheet.Paste
End Sub
 
Sort by date Sort by votes
Hey Jaime,

I think this is pretty close to what you want:
Code: 
Option Explicit

Private Const m_TARGET_SHEET_NAME As String = "Sheet3"
Private Const m_TARGET_SHEET_ROW_OFFSET As Long = 21
' Column offset from Source sheet to Target sheet (eg if Sheet1 Column A maps to Sheet2 Column B set to 1)
Private Const m_TARGET_SHEET_COL_OFFSET As Long = 0
Private Const m_TARGET_SHEET_FIRST_DATAROW As Long = 3

' Source sheet constants - SplitColumn is first column to display in Target sheet second data row
Private Const m_SOURCE_SHEET_NAME As String = "Sheet1"
Private Const m_SOURCE_SHEET_SPLIT_COLUMN As Long = 6
Private Const m_SOURCE_SHEET_LAST_DATA_COLUMN As Long = 10
Private Const m_SOURCE_SHEET_FIRST_DATA_COLUMN As Long = 1

Public Sub SetupFormulas()
    Dim strFormula As String
    Dim lngSourceSheetRow As Long, lngSourceSheetEndRow As Long, lngTargetSheetRow As Long, lngSourceSheetCol As Long, lngTargetSheetCol As Long
    
    ' Setup first Target sheet row
    lngTargetSheetRow = m_TARGET_SHEET_FIRST_DATAROW
    
    With Sheets(m_SOURCE_SHEET_NAME)
        
        ' Setup last Source sheet row
        lngSourceSheetEndRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        
        ' Iterate over all Source sheet Rows
        For lngSourceSheetRow = 1 To lngSourceSheetEndRow
        
            ' Only process non blank rows
            If Len(Trim$(.Cells(lngSourceSheetRow, "A").Value)) > 0 Then

                lngTargetSheetCol = 1 + m_TARGET_SHEET_COL_OFFSET
                
                ' Create formulas in Target sheet pointing into data in Source sheet
                For lngSourceSheetCol = m_SOURCE_SHEET_FIRST_DATA_COLUMN To m_SOURCE_SHEET_LAST_DATA_COLUMN
                    
                    ' Increment Target sheet row number at split column
                    If lngSourceSheetCol = m_SOURCE_SHEET_SPLIT_COLUMN Then
                        lngTargetSheetRow = lngTargetSheetRow + 1
                        lngTargetSheetCol = 1 + m_TARGET_SHEET_COL_OFFSET
                    End If
                                        
                    strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, lngSourceSheetCol).Address
                    Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, lngTargetSheetCol).Formula = strFormula
                    
                    lngTargetSheetCol = lngTargetSheetCol + 1
                Next lngSourceSheetCol
            
                lngTargetSheetRow = lngTargetSheetRow + 1
                
                ' Check for set of 8
                If lngSourceSheetRow Mod 8 = 0 Then
                    ' May need to + 1 or - 1 here to make it work correctly
                    lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET
                End If
            End If
        
        Next lngSourceSheetRow
    End With
End Sub 'SetupFormulas
This test data:
Code: 
A1	B1	C1	D1	E1	F1	G1	H1	I1	J1
A2	B2	C2	D2	E2	F2	G2	H2	I2	J2
A3	B3	C3	D3	E3	F3	G3	H3	I3	J3
A4	B4	C4	D4	E4	F4	G4	H4	I4	J4
A5	B5	C5	D5	E5	F5	G5	H5	I5	J5
A6	B6	C6	D6	E6	F6	G6	H6	I6	J6
A7	B7	C7	D7	E7	F7	G7	H7	I7	J7
A8	B8	C8	D8	E8	F8	G8	H8	I8	J8
A9	B9	C9	D9	E9	F9	G9	H9	I9	J9
A10	B10	C10	D10	E10	F10	G10	H10	I10	J10
A11	B11	C11	D11	E11	F11	G11	H11	I11	J11
A12	B12	C12	D12	E12	F12	G12	H12	I12	J12
A13	B13	C13	D13	E13	F13	G13	H13	I13	J13
A14	B14	C14	D14	E14	F14	G14	H14	I14	J14
A15	B15	C15	D15	E15	F15	G15	H15	I15	J15
A16	B16	C16	D16	E16	F16	G16	H16	I16	J16
A17	B17	C17	D17	E17	F17	G17	H17	I17	J17
A18	B18	C18	D18	E18	F18	G18	H18	I18	J18
A19	B19	C19	D19	E19	F19	G19	H19	I19	J19
A20	B20	C20	D20	E20	F20	G20	H20	I20	J20
A21	B21	C21	D21	E21	F21	G21	H21	I21	J21
A22	B22	C22	D22	E22	F22	G22	H22	I22	J22
A23	B23	C23	D23	E23	F23	G23	H23	I23	J23
A24	B24	C24	D24	E24	F24	G24	H24	I24	J24
yielded these results
Code: 
A1	B1	C1	D1	E1
F1	G1	H1	I1	J1
A2	B2	C2	D2	E2
F2	G2	H2	I2	J2
A3	B3	C3	D3	E3
F3	G3	H3	I3	J3
A4	B4	C4	D4	E4
F4	G4	H4	I4	J4
A5	B5	C5	D5	E5
F5	G5	H5	I5	J5
A6	B6	C6	D6	E6
F6	G6	H6	I6	J6
A7	B7	C7	D7	E7
F7	G7	H7	I7	J7
A8	B8	C8	D8	E8
F8	G8	H8	I8	J8





















A9	B9	C9	D9	E9
F9	G9	H9	I9	J9
A10	B10	C10	D10	E10
F10	G10	H10	I10	J10
A11	B11	C11	D11	E11
F11	G11	H11	I11	J11
A12	B12	C12	D12	E12
F12	G12	H12	I12	J12
A13	B13	C13	D13	E13
F13	G13	H13	I13	J13
A14	B14	C14	D14	E14
F14	G14	H14	I14	J14
A15	B15	C15	D15	E15
F15	G15	H15	I15	J15
A16	B16	C16	D16	E16
F16	G16	H16	I16	J16





















A17	B17	C17	D17	E17
F17	G17	H17	I17	J17
A18	B18	C18	D18	E18
F18	G18	H18	I18	J18
A19	B19	C19	D19	E19
F19	G19	H19	I19	J19
A20	B20	C20	D20	E20
F20	G20	H20	I20	J20
A21	B21	C21	D21	E21
F21	G21	H21	I21	J21
A22	B22	C22	D22	E22
F22	G22	H22	I22	J22
A23	B23	C23	D23	E23
F23	G23	H23	I23	J23
A24	B24	C24	D24	E24
F24	G24	H24	I24	J24
I setup most things with constants so you can set them as needed to match your data. Please post again if this isn't right. Good Luck!
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Edit: Didnt see your last post, will test that first, thanks!

Original message:
Ok now im confused :LOL:

I did not give correct row/column references before as i like to edit my code after it works (good for practice) but its confusing me now so ill give exact references although u are definately on the right track, thanks!

Sheet1 is called 'Selected Data'
Sheet2 is called 'Overview'

requested info:

1. What is the first row in Sheet2 which points back to Sheet1.Row1
Row 16
2. What column in Sheet2 points to Sheet1.A1
A16 points to B2, D16 points to E2, E16 points to AZ2, K16 points to C2, M16 points to S2
3. How many data columns exist in Sheet1
A upto BD (not all data taken for this overview)
4. What Sheet1 data column corresponds to the first Sheet2 second row
E17 points to BA2
5. Is Sheet1 data guaranteed to be in sets of 8 or could you end up with 19 rows or something odd like that
Always 8 sets of data, ie 16 rows
6. What is the Sheet2 row where Sheet1.Row9 should be mapped
Row 69
 
Upvote 0
Hi

Not usre if this helps

In our original code, you are Cutting the range and paste to another range.
That doesn't change the cell refernce in the formula.

Try copy then range first, then paste and clear the copied cell.
 
Upvote 0
Ok that is sort of what i need but unfortunately as to the answers to your previous questions the column references are not in sync, also this data needs to be aimed at an existing sheet, this is why i started trying to do it with copying/cutting because of the irregularity of the columns.

Impressive first code though, didnt think of doing it that way at all.
 
Upvote 0
1. What is the first row in Sheet2 which points back to Sheet1.Row1
Row 16
2. What column in Sheet2 points to Sheet1.A1
A16 points to B2, D16 points to E2, E16 points to AZ2, K16 points to C2, M16 points to S2
3. How many data columns exist in Sheet1
A upto BD (not all data taken for this overview)
4. What Sheet1 data column corresponds to the first Sheet2 second row
E17 points to BA2
5. Is Sheet1 data guaranteed to be in sets of 8 or could you end up with 19 rows or something odd like that
Always 8 sets of data, ie 16 rows
6. What is the Sheet2 row where Sheet1.Row9 should be mapped
Row 69
Click to expand...

A. It sounds like the block row increment is 53. Based on your response above, Sheet1.Row1 points to Overview.Row16, Sheet1.Row9 points to Overview.Row69, Sheet1.Row17 points to Overview.Row122, etc. Is this correct?

B. Can you clarify your answer in 2 above by giving the exact formulas in the Overview sheet for Sheet1.Row1 and Sheet1.Row2. Something like this would help to make it clear:
Overview Address Overview Formula
A16 =Sheet1!B2
D16 =Sheet1!E2
E16 =Sheet1!AZ2
K16 =Sheet1!C2
M16 =Sheet1!S2

E17 =Sheet1!BA2

C. Once we have the pattern as discussed above, does it then repeat continuously until all of the data in Sheet1 has been processed? Good Luck!
 
Upvote 0
A. It sounds like the block row increment is 53. Based on your response above, Sheet1.Row1 points to Overview.Row16, Sheet1.Row9 points to Overview.Row69, Sheet1.Row17 points to Overview.Row122, etc. Is this correct?

B. Can you clarify your answer in 2 above by giving the exact formulas in the Overview sheet for Sheet1.Row1 and Sheet1.Row2. Something like this would help to make it clear:
Overview Address Overview Formula
A16 =Sheet1!B2
D16 =Sheet1!E2
E16 =Sheet1!AZ2
K16 =Sheet1!C2
M16 =Sheet1!S2

E17 =Sheet1!BA2

C. Once we have the pattern as discussed above, does it then repeat continuously until all of the data in Sheet1 has been processed? Good Luck!
Click to expand...

A.Block Increment is 53 so references you have made are all correct, Sheet1.Row1 is not relevant as it is headers and data starts from second row.

B. the formula you have written are correct :)

C. Yes the data repeats, continuously, if there is no data in sheet1 it will make the Overview blank anyway, but ti is there if needed.
 
Upvote 0
I think this should do it. I just hard coded the individual formulas.
Code: 
Option Explicit

Private Const m_TARGET_SHEET_NAME As String = "Overview"
Private Const m_TARGET_SHEET_ROW_OFFSET As Long = 53
Private Const m_TARGET_SHEET_FIRST_DATAROW As Long = 16

' Source sheet constants - SplitColumn is first column to display in Target sheet second data row
Private Const m_SOURCE_SHEET_NAME As String = "Selected Data"
Private Const m_SOURCE_SHEET_FIRST_DATAROW As Long = 2

Public Sub SetupFormulas()
    Dim strFormula As String
    Dim lngSourceSheetRow As Long, lngSourceSheetEndRow As Long, lngTargetSheetRow As Long, lngSourceSheetCol As Long, lngTargetSheetCol As Long
    
    ' Setup first Sheet2 row
    lngTargetSheetRow = m_TARGET_SHEET_FIRST_DATAROW
    
    With Sheets(m_SOURCE_SHEET_NAME)
        
        ' Setup last Sheet1 row
        lngSourceSheetEndRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        
        ' Iterate over all Sheet 1 Rows
        For lngSourceSheetRow = m_SOURCE_SHEET_FIRST_DATAROW To lngSourceSheetEndRow
        
            ' Only process non blank rows
            If Len(Trim$(.Cells(lngSourceSheetRow, "B").Value)) > 0 Then

                ' Create formulas
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "B").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "A").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "E").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "D").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "AZ").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "E").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "C").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "K").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "S").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "M").Formula = strFormula
                
                ' Increment for second row
                lngTargetSheetRow = lngTargetSheetRow + 1
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "BA").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "E").Formula = strFormula
                
                ' Check for set of 8
                If lngSourceSheetRow Mod 8 = 0 Then
                    ' May need to + 1 or - 1 here to make it work correctly
                    lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET
                Else
                    ' Increment for next row
                    lngTargetSheetRow = lngTargetSheetRow + 1
                End If
            End If
        
        Next lngSourceSheetRow
    End With
End Sub 'SetupFormulas
Good Luck!
 
Upvote 0
Code: 
If lngSourceSheetRow Mod 8 = 0 Then 
                    ' May need to + 1 or - 1 here to make it work correctly 
                    lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET 
                Else 
                    ' Increment for next row 
                    lngTargetSheetRow = lngTargetSheetRow + 1 
                End If

It seems to work but it does not repeat, im guessing it has something to do with this but im not sure where i need to add the + 1 or - 1.
am i close?
 
Upvote 0
Try this:
Code: 
If (lngSourceSheetRow - m_SOURCE_SHEET_FIRST_DATAROW + 1) Mod 8 = 0 Then
Original code was based on assumption that data started in Row 1. If you single step through the code you should be pretty close I think. Is everything else working properly?

If your second set of data doesn't correctly begin on Row 69 you may need to add or subtract 1 from this line:
Code: 
lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET
Good Luck!
 
Upvote 0
Thank you, i figured it out,

Had to Change this line because it was missing 53 rows after 8 sets of data instaed of from the first line
Code: 
Private Const m_TARGET_SHEET_ROW_OFFSET As Long = 37

After a quick self tuition on what Mod does realised that it would never = 0 thus no repeating.
Code: 
If lngSourceSheetRow Mod 8 = 1 Then
And + 1 onto the end of this line to tidy up
Code: 
lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET + 1

Thanks for all your help,
here is the final code for future reference to anyone else :)

Code: 
Option Explicit

Private Const m_TARGET_SHEET_NAME As String = "Overview"
Private Const m_TARGET_SHEET_ROW_OFFSET As Long = 37
Private Const m_TARGET_SHEET_FIRST_DATAROW As Long = 16

' Source sheet constants - SplitColumn is first column to display in Target sheet second data row
Private Const m_SOURCE_SHEET_NAME As String = "Selected Data"
Private Const m_SOURCE_SHEET_FIRST_DATAROW As Long = 2

Public Sub SetupFormulas()
    Dim strFormula As String
    Dim lngSourceSheetRow As Long, lngSourceSheetEndRow As Long, lngTargetSheetRow As Long, lngSourceSheetCol As Long, lngTargetSheetCol As Long
    
    ' Setup first Sheet2 row
    lngTargetSheetRow = m_TARGET_SHEET_FIRST_DATAROW
    
    With Sheets(m_SOURCE_SHEET_NAME)
        
        ' Setup last Sheet1 row
        lngSourceSheetEndRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        
        ' Iterate over all Sheet 1 Rows
        For lngSourceSheetRow = m_SOURCE_SHEET_FIRST_DATAROW To lngSourceSheetEndRow
        
            ' Only process non blank rows
            If Len(Trim$(.Cells(lngSourceSheetRow, "B").Value)) > 0 Then

                ' Create formulas
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "B").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "A").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "E").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "D").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "AZ").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "E").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "C").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "K").Formula = strFormula
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "S").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "M").Formula = strFormula
                
                ' Increment for second row
                lngTargetSheetRow = lngTargetSheetRow + 1
                
                strFormula = "='" & m_SOURCE_SHEET_NAME & "'!" & .Cells(lngSourceSheetRow, "BA").Address
                Sheets(m_TARGET_SHEET_NAME).Cells(lngTargetSheetRow, "E").Formula = strFormula
                
                ' Check for set of 8
                If lngSourceSheetRow Mod 8 = 1 Then
                    ' May need to + 1 or - 1 here to make it work correctly
                    lngTargetSheetRow = lngTargetSheetRow + m_TARGET_SHEET_ROW_OFFSET + 1
                Else
                    ' Increment for next row
                    lngTargetSheetRow = lngTargetSheetRow + 1
                End If
            End If
        
        Next lngSourceSheetRow
    End With
End Sub 'SetupFormulas
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
294
GardianAngelUK
G
B
  • Question
VBA for New Table Data Calculations
Replies
0
Views
227
beginvbaanalyst
B
R
  • Question
COPY PASTE WIDE RANGE OF CELLS WITH FORMULAS FROM ONE SHEET TO ANOTHER SHEET
Replies
0
Views
370
Rob_Tob_2
R
gheyman
  • Solved
Code not placing the formula in the selected cells
Replies
2
Views
357
gheyman
gheyman
S
  • Question
Unique record creation using pairs of columns each loop
Replies
1
Views
493
SammyCRX
S

Forum statistics

Threads
1,215,003
Messages
6,122,655
Members
449,091
Latest member
peppernaut

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