table price update

[rjplante]

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.

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

 

[alansidman]

Build a loop for the columns and put your loop for the rows inside the column loop.

 

[rjplante]

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.

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
	C	D	E	F	G	H	I
4	1	1.2	1.4	2
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
19						TBD
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
Cell	Condition		Cell Format	Stop If True
C10	Expression	=MOD(COLUMN(),2)=0	text	NO
C22	Expression	=MOD(COLUMN(),2)=0	text	NO
C5	Expression	=MOD(COLUMN(),2)=0	text	NO
F12:F13	Expression	=MOD(COLUMN(),2)=0	text	NO
F10	Expression	=MOD(COLUMN(),2)=0	text	NO
E10:E17	Expression	=MOD(COLUMN(),2)=0	text	NO
H12:H13	Expression	=MOD(COLUMN(),2)=0	text	NO
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:I81	Expression	=MOD(COLUMN(),2)=0	text	NO