I have a customer that sends databases used for mailing. They are always consistent as far as number of columns, but all vary with the number of records (rows). I opened one up so I could record a macro for editing their lists down to just the necessary fields for importing into the mailing software. But then when I run the macro on any other database that differs (less records) I get the error message "subscript out of range".
Is it possible to get this macro to handle files no matter how many or few records are in a database I am needing to edit? Thank you!
Here's a copy of the script:
Sub ORRA_SGS_POLITICAL()
'
' ORRA_SGS_POLITICAL Macro
' PREPPING ORRA SGS POLITICAL LISTS FOR IMPORT
'
'
Columns("A:C").Select
Range("C1").Activate
Selection.Delete Shift:=xlToLeft
Columns("H:W").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
ActiveWindow.SmallScroll Down:=9
Range(Selection, Cells(1)).Select
Range("A2:F4501").Select
Range("F4501").Activate
ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort.SortFields. _
Add Key:=Range("C2:C4501"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort
.SetRange Range("A1:F4501")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B2").Select
ActiveCell.FormulaR1C1 = "=RC[1]&"" ""&RC[2]"
Range("B2").Select
Selection.Copy
Range("D2").Select
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=3
Range("B50").Select
Range(Selection, Selection.End(xlUp)).Select
Range("B3:B50").Select
Range("B50").Activate
ActiveSheet.Paste
Selection.End(xlUp).Select
ActiveWindow.SmallScroll Down:=-15
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
ActiveWindow.SmallScroll Down:=-12
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Columns("C:C").EntireColumn.AutoFit
Columns("D").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
Is it possible to get this macro to handle files no matter how many or few records are in a database I am needing to edit? Thank you!
Here's a copy of the script:
Sub ORRA_SGS_POLITICAL()
'
' ORRA_SGS_POLITICAL Macro
' PREPPING ORRA SGS POLITICAL LISTS FOR IMPORT
'
'
Columns("A:C").Select
Range("C1").Activate
Selection.Delete Shift:=xlToLeft
Columns("H:W").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
ActiveCell.SpecialCells(xlLastCell).Select
Selection.End(xlToLeft).Select
ActiveWindow.SmallScroll Down:=9
Range(Selection, Cells(1)).Select
Range("A2:F4501").Select
Range("F4501").Activate
ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort.SortFields. _
Add Key:=Range("C2:C4501"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SGS-IDLD08-IPF-14P-BeyelerBioMa").Sort
.SetRange Range("A1:F4501")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B2").Select
ActiveCell.FormulaR1C1 = "=RC[1]&"" ""&RC[2]"
Range("B2").Select
Selection.Copy
Range("D2").Select
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=3
Range("B50").Select
Range(Selection, Selection.End(xlUp)).Select
Range("B3:B50").Select
Range("B50").Activate
ActiveSheet.Paste
Selection.End(xlUp).Select
ActiveWindow.SmallScroll Down:=-15
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
ActiveWindow.SmallScroll Down:=-12
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Columns("C:C").EntireColumn.AutoFit
Columns("D").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub