Macro to clear data, copy new data and eliminate INDEX/MATCH formulas

Guestimator

New Member
Joined
Apr 28, 2016
Messages
6
I have a workbook with three tabs, NEUT, WORK and DBASE. I work in the WORK tab which uses INDEX/MATCH functions to pull information from the database. When I have an estimate completed I need to remove the index/match functions and leave the other formulas performing various calculations. I currently save the file as neutralized and copy and paste values for each column with the index/match formula. The columns with INDEX/Match are B:E,G,J,L,N,P,AA;BE. I added the NEUT tab and thought I could copy information from the WORK tab with all of the formatting and then remove the INDEX/MATCH functions by copy and paste value. I have 8900 rows in the NEUT tab so that I don't copy over the formulas at the bottom of the sheet. If I can get this to work smoothly I will not need to have multiple files for one project and it will save a lot of time. Since the WORK tab gets updated often I will need to be able to run this macro often. I labeled a cell in "A:A" below the totals, "COPY" that is a blank row with all formula and formatting. I also labeled a cell in "A:A" at the totals "END"

1. Clear existing data from NEUT tab. My thought was to copy a formatted row, labeled "COPY" in "A:A" and paste from row 10 to "END"-2 label in "A:A"
2. Copy all data from WORK tab row 10 to "END"
3. Copy columns B:E,G,J,L,N,P,AA;BE with INDEX/MATCH and paste as value.

Is there a way to make sure there are enough rows in the NEUT tab prior to copying the WORK tab so that I don't accidently copy over the total formulas at the bottom of the NEUT tab or is it better to leave the sheet with all those rows? I do not know how to write this code. I recorded the code below but it only copies to row 188, I need this to be variable since every estimate is a different # rows.

VBA Code:
Sub NEUTRALIZER()
'
' NEUTRALIZER Macro
'

'
    Rows("8924:8924").Select
    Selection.Copy
    Rows("10:8916").Select
    Range("A8916").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-24
    Sheets("WORK").Select
    Rows("9:187").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NEUT").Select
    Rows("10:10").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=63
    ActiveWindow.LargeScroll Down:=12
    ActiveWindow.ScrollRow = 803
    ActiveWindow.ScrollRow = 779
    ActiveWindow.ScrollRow = 755
    ActiveWindow.ScrollRow = 611
    ActiveWindow.ScrollRow = 466
    ActiveWindow.ScrollRow = 334
    ActiveWindow.ScrollRow = 298
    ActiveWindow.ScrollRow = 201
    ActiveWindow.ScrollRow = 153
    ActiveWindow.ScrollRow = 9
    Range("B10:E188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G10:G188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J10:J188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L10:L188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N10:N188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P10:P188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AA10:BE188").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
 

Attachments

  • 1577457276170.png
    1577457276170.png
    58 KB · Views: 7

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,890
It would probably be easiest to recreate the formulas at the bottom of the data rows and the required formatting throughout the data and total in code.
Is the last row in B:BE a sum formula for row 10 to the row above the formula row? If not, what formulas are in what column?

Does the last row of the WORK worksheet contain the same formulas?

Could you use Excel Genie (see link in my sig) or another program to post some portions of your worksheets.

This piece of code replaces the many Copy/PasteSpecial blocks at the end of your post.

Code:
Sub Partial()

    Dim lCOPYRow As Long
    Dim lADDRow As Long
    Dim aryIndexMatchColumns As Variant
    Dim lIMColIndex As Long
    Dim lActiveColumn As Long
    
    aryIndexMatchColumns = Array(7, 10, 12, 14, 16)
    '                            G   J   L   N   P
    Dim lLastCopyRow As Long
    
    lLastCopyRow = 188
    With Range("B10:E" & lLastCopyRow)
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
    
    For lIMColIndex = LBound(aryIndexMatchColumns) To UBound(aryIndexMatchColumns)
        lActiveColumn = aryIndexMatchColumns(lIMColIndex)
        With Range(Cells(10, lActiveColumn), Cells(lLastCopyRow, lActiveColumn))
            .Copy
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        End With
    Next
    
    With Range("AA10:BE" & lLastCopyRow)
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
    

End Sub
 

Guestimator

New Member
Joined
Apr 28, 2016
Messages
6
Yes, the last row sums all data from row 7 down.
Yes, the WORK worksheet contains the same sum formulas.
The NEUT worksheet is a copy of the WORK worksheet without any IndexMatch formulas.
Would it be easier to copy the WORK worksheet complete to the NEUT worksheet and then remove the IndexMatch formulas from the NEUT worksheet.
Cell Formulas
RangeFormula
E10, E13:E20, E11:E12E10=INDEX(VEACH,MATCH($A10,VCODE,0))
F10, F13:F20, F11:F12F10=G10*D10
H10:H20H10=G10*I$4
I10:I20I10=H10*D10
J10:J20J10=INDEX(VMATLU,MATCH($A10,VCODE,0))
K10:K20K10=D10*J10
L10:L20L10=INDEX(VSUBU,MATCH($A10,VCODE,0))
M10:M20M10=D10*L10
N10:N20N10=INDEX(VEQPU,MATCH($A10,VCODE,0))
O10:O20O10=D10*N10
P10:P20P10=INDEX(VOTHU,MATCH($A10,VCODE,0))
Q10:Q20Q10=D10*P10
R10:R20R10=SUM(I10,K10,M10,O10,Q10)
G11:G12G11=INDEX(VMHU,MATCH($A11,VCODE,0))
C10:C20C10=INDEX(VDESC,MATCH($A10,VCODE,0))
F23, Q23:R23, O23, M23, K23, I23F23=SUM(F7:F22)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,732
Messages
5,638,042
Members
417,000
Latest member
JasonWilliam

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