Parse Macro VBA


Uncategorized

Updated Nov 6th, 2021

Overview

Non-Dynamic

Sub Parsee()
'
' Parsee Macro
'

'
    Sheets(1).Select
    Sheets(1).Copy Before:=Sheets(1)
    Sheets(1).Select
    Sheets(1).Name = "_PARSE"
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G").Select
    Range("G1").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "{name:"""
    Range("C2").Select
    ActiveCell.FormulaR1C1 = """, pos:"""
    Range("E2").Select
    ActiveCell.FormulaR1C1 = """, salary:"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = ", team:"""
    Range("I2").Select
    ActiveCell.FormulaR1C1 = """, ppg:"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = ", proj:"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = ", cpp:"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "},"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O569")
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M569")
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K569")
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I569")
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G569")
    ActiveWindow.ScrollColumn = 1
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E569")
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C569")
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A569")
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub

Converted to Dynamic

Sub ParseData()
'
' ParseData Macro
'
' Need to have tab you want to parse in the first tab position
'

Dim LastRowOfTab As Long

LastRowOfTab = Range("A" & Rows.Count).End(xlUp).Row

'
    Sheets(1).Select
    Sheets(1).Copy Before:=Sheets(1)
    Sheets(1).Select
    Sheets(1).Name = "_PARSE"
    Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G").Select
    Range("G1").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "{name:"""
    Range("C2").Select
    ActiveCell.FormulaR1C1 = """, pos:"""
    Range("E2").Select
    ActiveCell.FormulaR1C1 = """, salary:"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = ", team:"""
    Range("I2").Select
    ActiveCell.FormulaR1C1 = """, ppg:"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = ", proj:"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = ", cpp:"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "},"
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O" & LastRowOfTab)
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M" & LastRowOfTab)
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K" & LastRowOfTab)
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I" & LastRowOfTab)
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G" & LastRowOfTab)
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E" & LastRowOfTab)
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & LastRowOfTab)
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A" & LastRowOfTab)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub

Final Touches

The first row with heading names should be deleted. The range should be selected and copied to the clipboard.

    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1:O589").Select
    Selection.Copy