table price update

rjplante

Active Member
Joined
Oct 31, 2008
Messages
489
I have a large table that consists of 7 columns and 750 plus rows. Column B can be used to find the last row in the table. Now every cell has data in it. I have another cell that has a decimal, representing a percent value to increase each value in the table (5% cell reads 0.050). I have included some of my code below. How to I start at the top of one column, go all the way to the bottom, and then move tot he next column until all 7 columns are updated. Maybe I don't even need to worry about column position. I am open to slick efficient ways to get this done. I currently have a do until loop for one column, do I need to write the same loop for all 7 columns? Thanks for the help on this.

VBA Code:
Dim priceUpdt As String
Dim ChangePercent As String
Dim LastRow As Long
Dim sht As Worksheet

Set sht = ActiveSheet

LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row

'Asks user to confirm choice.
i = MsgBox("Would you like to clear the pricing archive and update with current pricing?" & vbCrLf & "This cannot be undone!", vbYesNo + vbExclamation + vbDefaultButton2)

If i = 7 Then 'NO
    Exit Sub
ElseIf i = 6 Then 'YES
Sheets("Pricing Table").Range("DA5:DG761").ClearContents

Sheets("Pricing Table").Range("DA5:DG761").Value = Sheets("Pricing Table").Range("C5:I761").Value

'   Cell X2 contains the decimal form of the percent increase
dRate = Sheets("Pricing Table").Range("X2").Value
priceUpdt = 1 + dRate

'   Table Data starts in Cell C5, so C4 is where I need to start to get the loop to work
Sheets("Pricing Table").Range("C4").Select

Do Until ActiveCell.Row = LastRow
    ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "" Then
            End If
        Else
            ActiveCell.Value = ActiveCell.Value * priceUpdt
        End If
Loop

End If
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
6,069
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Build a loop for the columns and put your loop for the rows inside the column loop.
 

rjplante

Active Member
Joined
Oct 31, 2008
Messages
489
I have nested the row loop inside the column loop and I am having a small problem. I am running into a filetype mismatch error 13. I have checked the declarations and changed the two that could be in conflict. I have tried setting them up as string, long, and variant, all to no avail. String should be a problem, but I thought either long or variant should work. My macro code appears below and it fails on the line below which is under the else option in the do loop. I have also checked the cell formatting for cell X2 (formatted as a number), and the data table (C5:I755) to be updated (formatted as currency). Because of the line that flags with the error. I am looking to change the declaration type for the priceUpdt and the ChangePercent items. I appreciate any help with this.

Failure line: ActiveCell.Value = ActiveCell.Value * priceUpdt

Here is my macro code.

VBA Code:
Sub FULL_PRICE_UPDATE()

Application.ScreenUpdating = False

Dim priceUpdt As Variant
Dim ChangePercent As Variant
Dim LastRow As Long
Dim sht As Worksheet
Dim myCell As Range

Dim i As Long
Dim rng As Range

If Sheets("Pricing Table").Range("N2").Value = "" Then
    MsgBox "Percent increase value has not been entered.", vbExclamation
    Sheets("Pricing Table").Range("N2").Select
    Exit Sub
End If

'+++++++++++++++++++++++++

Set sht = ActiveSheet

LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row

'Asks user to confirm choice.
i = MsgBox("WARNING: This will clear the pricing archive and update all prices by " & Range("X2").Value * 100 & " percent." _
    & vbCrLf & "This cannot be undone!" & vbCrLf & "Do you wish to proceed?", vbYesNo + vbExclamation + vbDefaultButton2)

If i = 7 Then 'NO
    Exit Sub
ElseIf i = 6 Then 'YES
    '   Copies the data in current pricing table to the archive table.
    Sheets("Pricing Table").Range("DA5:DG761").ClearContents    'this clears the archive pricing table
    Sheets("Pricing Table").Range("DA5:DG761").Value = Sheets("Pricing Table").Range("C5:I761").Value
    
    '   Cell X2 contains the decimal form of the percent increase
    ChangePercent = Sheets("Pricing Table").Range("X2").Value
    priceUpdt = 1 + ChangePercent
    
    '   Table Data starts in Cell C5, so C4 is where I need to start to get the loop to work
    Sheets("Pricing Table").Range("A4").Select
    
    Set rng = ActiveCell

'   Begin column loop to move from column C (3) to column I (9)
    i = 3
    
    For i = 3 To 9
        rng.Offset(0, i - 1).Select
        Set myCell = ActiveCell
        
'   Change all pricing in this column
'   Begin row loop to change all values in this column
    
        myCell.Select
    
        Do Until ActiveCell.Row = LastRow
            If ActiveCell.Offset(1, 0).Value = "" Then
                ActiveCell.End(xlDown).Select
                ActiveCell.Value = ActiveCell.Value * priceUpdt
            Else
                ActiveCell.Offset(1, 0).Select
                ActiveCell.Value = ActiveCell.Value * priceUpdt
            End If
        Loop
        
    Next i

    MsgBox "Price update is done."

End If

With ActiveWindow
    .ScrollColumn = 1
    .ScrollRow = 1
End With

Application.ScreenUpdating = True

End Sub



Spreadsheet Data table.

Mod-Tech Pricing Template 07-JAN-2021 TEST.xlsm
CDEFGHI
411.21.42
5$289,380.00 $285,900.00$300,000.00$398,100.00$450,000.00
6$400,000.00$460,000.00
7$313,120.00
8
9
10$28,334.25 $25,700.00$25,700.00$25,700.00$27,325.00$25,700.00
11$40,654.69$36,875.00$36,875.00$36,875.00$39,225.00$36,875.00$36,875.00
12$16,868.25$15,300.00$15,300.00$15,300.00$15,300.00$15,300.00
13$28,334.25$25,700.00$25,700.00$25,700.00$25,700.00$25,700.00
14$9,977.63$9,050.00$9,050.00$9,050.00$9,050.00$9,050.00
15$6,900.00$6,900.00
16$716.63$650.00$650.00$650.00$650.00$650.00
17$716.63$650.00$650.00$650.00$650.00$650.00
18$10,625.00
19TBD
20
21
22$523.69 $475.00$455.00
23$9,261.00$8,400.00$9,200.00
24$14,828.63$13,450.00$15,000.00
25$18,494.44$16,775.00$18,000.00
26$22,242.94$20,175.00$20,000.00
27$25,881.19$23,475.00$25,000.00
28$29,629.69$26,875.00$32,000.00$50,000.00$65,000.00
29$33,378.19$30,275.00$35,000.00
30
31
Pricing Table
Cells with Conditional Formatting
CellConditionCell FormatStop If True
C10Expression=MOD(COLUMN(),2)=0textNO
C22Expression=MOD(COLUMN(),2)=0textNO
C5Expression=MOD(COLUMN(),2)=0textNO
F12:F13Expression=MOD(COLUMN(),2)=0textNO
F10Expression=MOD(COLUMN(),2)=0textNO
E10:E17Expression=MOD(COLUMN(),2)=0textNO
H12:H13Expression=MOD(COLUMN(),2)=0textNO
D283:F283,C146:C151,E147:F151,D148:D151,C259:F262,C160:F172,C118:I121,C178:I185,C174:I176,G161:I172,C153:I158,C199:I201,C195:I197,C187:I193,C215:I219,C212:I213,C244:I246,C241:I242,C236:I239,C268:I269,G260:I262,C208:I210,C271:I272,C291:I294,G140:I151,C79:I81Expression=MOD(COLUMN(),2)=0textNO
VBA Code:
 

Watch MrExcel Video

Forum statistics

Threads
1,123,194
Messages
5,600,251
Members
414,374
Latest member
akbir

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