Dynamic Ranges for my macro

[catharsis50]

I am a beginner at creating macros and simply recorded the steps I needed to perform. The issues I ran into was when using shortcuts like ctrl+shift+dn.arrw to select a whole range, it was recorded as that specific cell range. I need this sheet to work for a dynamic range of data, so it can change with the number of rows.

Below is the current VBA, I assume it would be easier to send you the sheet so let me know if you would like me to email it.

Thanks in advance for the help.

VBA:


Public Function MultiCat( _
ByRef rRng As Excel.Range, _
Optional ByVal sDelim As String = "") _
As String
Dim rCell As Range
For Each rCell In rRng
MultiCat = MultiCat & sDelim & rCell.Text
Next rCell
MultiCat = Mid(MultiCat, Len(sDelim) + 1)
End Function
Sub Get_Zip()
'
' Get_Zip Macro
'

'
Range("I4").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-8],3)"
Range("I4").Select
Selection.AutoFill Destination:=Range("I4:I137")
Range("I4:I137").Select
Selection.Copy
Range("K4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$K$4:$K$137").RemoveDuplicates Columns:=1, Header:=xlNo
Range("L4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]&"","""
Range("L4").Select
Selection.AutoFill Destination:=Range("L4:L9")
Range("L4:L9").Select
Selection.End(xlDown).Select
Range("K9").Select
Selection.Copy
Range("L9").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("M4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=multicat(RC[-1]:R[5]C[-1])"
Range("M4").Select
Selection.Copy
Range("M5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub Get_Areacode()
'
' Get_Areacode Macro
'

'
ActiveCell.FormulaR1C1 = "=LEFT(RC[-4],3)"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E1661")
Range("E2:E1661").Select
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$G$2:$G$1661").RemoveDuplicates Columns:=1, Header:=xlNo
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]&"","""
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H5")
Range("H2:H5").Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
Range("G6").Select
ActiveSheet.Paste
Range("H6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=""(""&RC[-1]&"","""
Range("H6").Select
Selection.AutoFill Destination:=Range("H6:H9")
Range("H6:H9").Select
Range("G6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
Range("G10").Select
ActiveSheet.Paste
Range("H10").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=""1+ ""&RC[-1]&"","""
Range("H10").Select
Selection.AutoFill Destination:=Range("H10:H13")
Range("H10:H13").Select
Range("G10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
Range("G14").Select
ActiveSheet.Paste
Range("H14").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=""1.""&RC[-1]&"","""
Range("H14").Select
Selection.AutoFill Destination:=Range("H14:H17")
Range("H14:H17").Select
Selection.End(xlDown).Select
Range("G17").Select
Selection.Copy
Range("H17").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
Range("I2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=multicat(RC[-1]:R[15]C[-1])"
Range("I2").Select
Selection.Copy
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("I4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$I$4:$I$1663").RemoveDuplicates Columns:=1, Header:= _
xlYes
End Sub

 

[tlowry]

This is going to be a lot of work for you. Here’s a start:

>>>Instead of specifying a range as “Range("I4")” Name the range in the worksheet i.e. “Range(“StartCell”) that way you need only to change the range name location in the workbook not in the Macro

>>>Remove the “.Select” where possible

Thus

Range("I4").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-8],3)"

Becomes:

Range(“StartCell”).FormulaR1C1 = "=LEFT(RC[-8],3)"

>>>Make backup copies as changes work
>>>Save often
>>>Do changes incrementally
>>>Test after each change

 

[catharsis50]

Ok I'll start there. My biggest concern is getting the range to select to the last cell populated with data, is what you suggested a solve for that or just where the macro starts? My goal is to get the macro when selecting the data to behave as excel would when you hit ctrl+shft+dwn.arrow. If I can get it to do that I can get this working as I want.

Thanks!

 

[tlowry]

Function iRowStartBottom(sCol As String) As Integer
iRowStart = Range(sCol & Trim("65536")).End(xlUp).Row
End Function

Function iRowStartTop(sCol As String) As Integer
iRowStart = Range(sCol & Trim("1")).End(xlDown).Row
End Function