resizing a table with vba

D

David217

New Member
Joined
Jun 8, 2017
Messages
2
Hi all,

The code below is what I am working with.
I need it to do the following:

Proper Case in Column A,B,C
Upper Case in Column D
Postal Abbreviations Convert
Keeps 20 Rows at end of table

I plan on adding more to it later but this is where I am at right now

So far Macro1,2,3 work but when I add in Macro4 it gives an error every time I press enter at the end of the table in column A.

Can someone tell me what I did wrong? Cause I am not sure what is happening or how to fix it.

Thank you.

Code: 
Option ExplicitOption Compare Text

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Call Macro1(Target)     ''Proper Case in Column A,B,C
    Call Macro2(Target)     ''Upper Case in Column D
    Call Macro3(Target)     ''Postal Abbreviations Convert
    Call Macro4(Target)     ''Keeps 20 Rows at end of table.
          
End Sub
     
Sub Macro1(ByVal Target As Excel.Range)
     
    On Error GoTo Error
    
    Dim rngCell As Range
     
    If Intersect(Target, Range("A2:C5000")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each rngCell In Target.Cells
        Target.Value = Application.WorksheetFunction.Proper(Target.Value)
    Next
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Error:          ''Error Handling
   MsgBox "Press OK to Continue."
   Resume Letscontinue
        
 End Sub

Sub Macro2(ByVal Target As Excel.Range)
    On Error GoTo Error1
    Dim rngCell As Range
     
    If Intersect(Target, Range("D2:D5000")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each rngCell In Target.Cells
       Target = UCase(Target)
    Next
Letscontinue1:
    Application.EnableEvents = True
      
Exit Sub
Error1:     ''Error Handling
   MsgBox "Press OK to Continue."
   Resume Letscontinue1
End Sub

Sub Macro3(ByVal Target As Range)

Dim r As Range, cel As Range
Set r = Range("D2:D5000")

For Each cel In r

    Select Case cel.Value
         ''U.S.A Postal Abbreviations
        Case "Alabama"
            cel.Offset(, 0).Value = "AL"
        Case "Alaska"
            cel.Offset(, 0).Value = "AK"
        Case "Arizona"
            cel.Offset(, 0).Value = "AZ"
        Case "Arkansas"
            cel.Offset(, 0).Value = "AR"
        Case "California"
            cel.Offset(, 0).Value = "CA"
        Case "Colorado"
            cel.Offset(, 0).Value = "CO"
        Case "Connecticut"
            cel.Offset(, 0).Value = "CT"
        Case "Delaware"
            cel.Offset(, 0).Value = "DE"
        Case "Florida"
            cel.Offset(, 0).Value = "FL"
        Case "Georgia"
            cel.Offset(, 0).Value = "GA"
        Case "Hawaii"
            cel.Offset(, 0).Value = "HI"
        Case "Idaho"
            cel.Offset(, 0).Value = "ID"
        Case "Illinois"
            cel.Offset(, 0).Value = "IL"
        Case "Indiana"
            cel.Offset(, 0).Value = "IN"
        Case "Iowa"
            cel.Offset(, 0).Value = "IA"
        Case "Kansas"
            cel.Offset(, 0).Value = "KS"
        Case "Kentucky"
            cel.Offset(, 0).Value = "KY"
        Case "Louisiana"
            cel.Offset(, 0).Value = "LA"
        Case "Maine"
            cel.Offset(, 0).Value = "ME"
        Case "Maryland"
            cel.Offset(, 0).Value = "MD"
        Case "Massachusetts"
            cel.Offset(, 0).Value = "MA"
        Case "Michigan"
            cel.Offset(, 0).Value = "MI"
        Case "Minnesota"
            cel.Offset(, 0).Value = "MN"
        Case "Mississippi"
            cel.Offset(, 0).Value = "MS"
        Case "Missouri"
            cel.Offset(, 0).Value = "MO"
        Case "Montana"
            cel.Offset(, 0).Value = "MT"
        Case "Nebraska"
            cel.Offset(, 0).Value = "NE"
        Case "Nevada"
            cel.Offset(, 0).Value = "NV"
        Case "New Hampshire"
            cel.Offset(, 0).Value = "NH"
        Case "New Jersey"
            cel.Offset(, 0).Value = "NJ"
        Case "New Mexico"
            cel.Offset(, 0).Value = "NM"
        Case "New York"
            cel.Offset(, 0).Value = "NY"
        Case "North Carolina"
            cel.Offset(, 0).Value = "NC"
        Case "North Dakota"
            cel.Offset(, 0).Value = "ND"
        Case "Ohio"
            cel.Offset(, 0).Value = "OH"
        Case "Oklahoma"
            cel.Offset(, 0).Value = "OK"
        Case "Oregon"
            cel.Offset(, 0).Value = "OR"
        Case "Pennsylvania"
            cel.Offset(, 0).Value = "PA"
        Case "Rhode Island"
            cel.Offset(, 0).Value = "RI"
        Case "South Carolina"
            cel.Offset(, 0).Value = "SC"
        Case "South Dakota"
            cel.Offset(, 0).Value = "SD"
        Case "Tennessee"
            cel.Offset(, 0).Value = "TN"
        Case "Texas"
            cel.Offset(, 0).Value = "TX"
        Case "Utah"
            cel.Offset(, 0).Value = "UT"
        Case "Vermont"
            cel.Offset(, 0).Value = "VT"
        Case "Virginia"
            cel.Offset(, 0).Value = "VA"
        Case "Washington"
            cel.Offset(, 0).Value = "WA"
        Case "West Virginia"
            cel.Offset(, 0).Value = "WV"
        Case "Wisconsin"
            cel.Offset(, 0).Value = "WI"
        Case "Wyoming"
            cel.Offset(, 0).Value = "WY"
        ''Canadian Postal Abbreviations
        Case "Alberta"
            cel.Offset(, 0).Value = "AB"
        Case "British Columbia", "Colombie-Britannique"
            cel.Offset(, 0).Value = "BC"
        Case "New Brunswick", "Nouveau-Brunswick"
            cel.Offset(, 0).Value = "NB"
        Case "Newfoundland and Labrador", "Terre-Neuve-et-Labrador"
            cel.Offset(, 0).Value = "NL"
        Case "Manitoba", "Terre-Neuve-et-Labrador"
            cel.Offset(, 0).Value = "MB"
        Case "Nova Scotia", "Nouvelle-Écosse"
            cel.Offset(, 0).Value = "NS"
        Case "Northwest Territories", "Territoires du Nord-Ouest"
            cel.Offset(, 0).Value = "NT"
        Case "Nunavut"
            cel.Offset(, 0).Value = "NU"
        Case "Ontario"
            cel.Offset(, 0).Value = "ON"
        Case "Prince Edward Island", "Île-du-Prince-Édouard"
            cel.Offset(, 0).Value = "PE"
        Case "Quebec", "Québec"
            cel.Offset(, 0).Value = "QC"
        Case "Saskatchewan"
            cel.Offset(, 0).Value = "SK"
        Case "Yukon"
            cel.Offset(, 0).Value = "YT"
            
       'Copy the below 2 lines to add to list
       ' Case ""
        '    cel.Offset(, 0).Value = ""
            
    End Select
    
Next cel

End Sub

Sub Macro4(ByVal Target As Range)

Dim rng As Range            ''Expand Table size by 20 rows
Dim tbl As ListObject       ''Expand Table size by 20 rows
  
''Expand Table size by 20 rows
  Set tbl = ActiveSheet.ListObjects("Table1")      ''Change Table #
  
  Set rng = Range("Table1[#All]").Resize(tbl.Range.Rows.Range("A1").End(xlDown).Row + 20, tbl.Range.Columns.Count)       ''Change Table #
  
  tbl.Resize rng


End Sub
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Hi and welcome to the MrExcel Message Board.

I think the basic problem is that you are not turning off "events" at the start of Macro4.

That means that every time you add 20 rows the whole series of macros is being called again because of that change. Then you get stuck in a loop. So add the red lines below:
Rich (BB code): 
Sub Macro4(ByVal Target As Range)

Dim rng As Range            ''Expand Table size by 20 rows
Dim tbl As ListObject       ''Expand Table size by 20 rows

Application.EnableEvents = False
''Expand Table size by 20 rows
  Set tbl = ActiveSheet.ListObjects("Table1")      ''Change Table #
  
  Set rng = Range("Table1[#All]").Resize(tbl.Range.Rows.Range("A1").End(xlDown).Row + 20, tbl.Range.Columns.Count)       ''Change Table #
  
  tbl.Resize rng

Application.EnableEvents = True
End Sub
You really ought to check for errors in there as well so that events are re-enabled even if there is an error.

I could not resist but re-arrange things somewhet so that only one set of error handling statements was required. It is not fully tested and you are under no obligation to use it. :)

Rich (BB code): 
Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Application.EnableEvents = False
    On Error GoTo Error
    
    Call Macro1(Target)     ''Proper Case in Column A,B,C
    Call Macro3(Target)     ''Postal Abbreviations Convert
    Call Macro4(Target)     ''Keeps 20 Rows at end of table.
    
    Application.EnableEvents = True
    Exit Sub
Error:
    MsgBox "Press OK to Continue." & vbLf & "Error: " & Err.Description
    Application.EnableEvents = True
End Sub
     
Sub Macro1(ByVal Target As Excel.Range)
    Dim rngCell As Range
     
    If Intersect(Target, Range("A2:C5000")) Is Nothing Then Exit Sub
    
    For Each rngCell In Intersect(Target, Range("A2:C5000"))
        rngCell.Value = Application.WorksheetFunction.Proper(rngCell.Value)
    Next
 End Sub

Sub Macro3(ByVal Target As Range)
    Dim cel     As Range
    
    If Intersect(Target, Range("D2:D5000")) Is Nothing Then Exit Sub
    
    For Each cel In Intersect(Target, Range("D2:D5000"))
        Select Case cel.Value
             ''U.S.A Postal Abbreviations
            Case "Alabama":         cel.Offset(, 0).Value = "AL"
            Case "Alaska":          cel.Offset(, 0).Value = "AK"
            Case "Arizona":         cel.Offset(, 0).Value = "AZ"
            Case "Arkansas":        cel.Offset(, 0).Value = "AR"
            Case "California":      cel.Offset(, 0).Value = "CA"
            Case "Colorado":        cel.Offset(, 0).Value = "CO"
            Case "Connecticut":     cel.Offset(, 0).Value = "CT"
            Case "Delaware":        cel.Offset(, 0).Value = "DE"
            Case "Florida":         cel.Offset(, 0).Value = "FL"
            Case "Georgia":         cel.Offset(, 0).Value = "GA"
            Case "Hawaii":          cel.Offset(, 0).Value = "HI"
            Case "Idaho":           cel.Offset(, 0).Value = "ID"
            Case "Illinois":        cel.Offset(, 0).Value = "IL"
            Case "Indiana":         cel.Offset(, 0).Value = "IN"
            Case "Iowa":            cel.Offset(, 0).Value = "IA"
            Case "Kansas":          cel.Offset(, 0).Value = "KS"
            Case "Kentucky":        cel.Offset(, 0).Value = "KY"
            Case "Louisiana":       cel.Offset(, 0).Value = "LA"
            Case "Maine":           cel.Offset(, 0).Value = "ME"
            Case "Maryland":        cel.Offset(, 0).Value = "MD"
            Case "Massachusetts":   cel.Offset(, 0).Value = "MA"
            Case "Michigan":        cel.Offset(, 0).Value = "MI"
            Case "Minnesota":       cel.Offset(, 0).Value = "MN"
            Case "Mississippi":     cel.Offset(, 0).Value = "MS"
            Case "Missouri":        cel.Offset(, 0).Value = "MO"
            Case "Montana":         cel.Offset(, 0).Value = "MT"
            Case "Nebraska":        cel.Offset(, 0).Value = "NE"
            Case "Nevada":          cel.Offset(, 0).Value = "NV"
            Case "New Hampshire":   cel.Offset(, 0).Value = "NH"
            Case "New Jersey":      cel.Offset(, 0).Value = "NJ"
            Case "New Mexico":      cel.Offset(, 0).Value = "NM"
            Case "New York":        cel.Offset(, 0).Value = "NY"
            Case "North Carolina":  cel.Offset(, 0).Value = "NC"
            Case "North Dakota":    cel.Offset(, 0).Value = "ND"
            Case "Ohio":            cel.Offset(, 0).Value = "OH"
            Case "Oklahoma":        cel.Offset(, 0).Value = "OK"
            Case "Oregon":          cel.Offset(, 0).Value = "OR"
            Case "Pennsylvania":    cel.Offset(, 0).Value = "PA"
            Case "Rhode Island":    cel.Offset(, 0).Value = "RI"
            Case "South Carolina":  cel.Offset(, 0).Value = "SC"
            Case "South Dakota":    cel.Offset(, 0).Value = "SD"
            Case "Tennessee":       cel.Offset(, 0).Value = "TN"
            Case "Texas":           cel.Offset(, 0).Value = "TX"
            Case "Utah":            cel.Offset(, 0).Value = "UT"
            Case "Vermont":         cel.Offset(, 0).Value = "VT"
            Case "Virginia":        cel.Offset(, 0).Value = "VA"
            Case "Washington":      cel.Offset(, 0).Value = "WA"
            Case "West Virginia":   cel.Offset(, 0).Value = "WV"
            Case "Wisconsin":       cel.Offset(, 0).Value = "WI"
            Case "Wyoming":         cel.Offset(, 0).Value = "WY"
            ''Canadian Postal Abbreviations
            Case "Alberta":                                                 cel.Offset(, 0).Value = "AB"
            Case "British Columbia", "Colombie-Britannique":                cel.Offset(, 0).Value = "BC"
            Case "New Brunswick", "Nouveau-Brunswick":                      cel.Offset(, 0).Value = "NB"
            Case "Newfoundland and Labrador", "Terre-Neuve-et-Labrador":    cel.Offset(, 0).Value = "NL"
            Case "Manitoba", "Terre-Neuve-et-Labrador":                     cel.Offset(, 0).Value = "MB"
            Case "Nova Scotia", "Nouvelle-Écosse":                          cel.Offset(, 0).Value = "NS"
            Case "Northwest Territories", "Territoires du Nord-Ouest":      cel.Offset(, 0).Value = "NT"
            Case "Nunavut":                                                 cel.Offset(, 0).Value = "NU"
            Case "Ontario":                                                 cel.Offset(, 0).Value = "ON"
            Case "Prince Edward Island", "Île-du-Prince-Édouard":           cel.Offset(, 0).Value = "PE"
            Case "Quebec", "Québec":                                        cel.Offset(, 0).Value = "QC"
            Case "Saskatchewan":                                            cel.Offset(, 0).Value = "SK"
            Case "Yukon":                                                   cel.Offset(, 0).Value = "YT"
        End Select
    Next cel
End Sub

Sub Macro4(ByVal Target As Range)
    Dim rng As Range            ''Expand Table size by 20 rows
    Dim tbl As ListObject       ''Expand Table size by 20 rows
    
    ''Expand Table size by 20 rows
    Set tbl = ActiveSheet.ListObjects("Table1")      ''Change Table #
    Set rng = Range("Table1[#All]").Resize(tbl.Range.Rows.Range("A1").End(xlDown).Row + 20, tbl.Range.Columns.Count)       ''Change Table #
    tbl.Resize rng
End Sub

Sub reset()
    Application.EnableEvents = True
End Sub
Note: I omitted Macro2 because if you overwrite the state with the code then it is not required but I appreciate you may change that requirement.


Regards,
 
Upvote 0
PM
RickXL,

Thank you so much for the help.
I didn't even think of trying to turn off events.

As for the error handling that was one thing I wanted to change, just was not sure how to go about it.
I really appreciate that you gave me a solution to that.

I will look/try the re-arranged code later, just don't have time right now.


Thanks,
 
Upvote 0
Thanks for updating me.

I have a tendency to re-write people's code for them - don't take it personally! The trouble is that if it looks unfamiliar I find it more difficult to understand.

Events

If you use events you need to watch how many times they are being called because it is very easy to get them stuck in a loop. One way to find out what is happening is to place a breakpoint on the Worksheet_Change line and then single step when it is called. That will let you see if it is looping.

The second point is to always make sure that you re-enable events if there is an error and something quits early. Otherwise they just stop working.


Regards,
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Change Log With VBA
2
Replies
19
Views
873
Joe4
Joe4
C
  • Question Question
VBA Insert Picture Into Cell - Not working
Replies
7
Views
2K
sancarn
sancarn
N
  • Solved
Copy/paste a row from within a loop, before that loop moves on to next cell
Replies
5
Views
525
Joe4
Joe4
T
  • Solved
VBA Macro to sort table by vendor copy table into email body and send, then do the same for the next vendor in the table to the last vendor
Replies
5
Views
1K
takingiwhanau
T
H
  • Solved
Text in cell return formula
Replies
4
Views
574
HelJLL
H

Forum statistics

Threads
1,223,889
Messages
6,175,223
Members
452,620
Latest member
dsubash

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