Sub RemedyFormat()
'
' RemedyFormat Macro
' Macro recorded 5/13/2005 by aehrenwo
'
' Keyboard Shortcut: Ctrl+Shift+R
'
I am a "amateur" VBA coder, still learning some of the shortcuts and other tricks to make programming a little easier. I just finished a code that helps for format a document in an unusuable format into one that makes more sense. I think coded it efficiently but I am sure there are things that can be tweaked or done in lieu of some of the choices I made. I would appreciate if anyone could look over this if they have time and provide some pointers for the next time I do this type of coding. This one works fairly quickly when are only a few lines of data but might take much longer with bigger spreadsheets.
Thanks,
KC
'
' RemedyFormat Macro
' Macro recorded 5/13/2005 by aehrenwo
'
' Keyboard Shortcut: Ctrl+Shift+R
'
I am a "amateur" VBA coder, still learning some of the shortcuts and other tricks to make programming a little easier. I just finished a code that helps for format a document in an unusuable format into one that makes more sense. I think coded it efficiently but I am sure there are things that can be tweaked or done in lieu of some of the choices I made. I would appreciate if anyone could look over this if they have time and provide some pointers for the next time I do this type of coding. This one works fairly quickly when are only a few lines of data but might take much longer with bigger spreadsheets.
Code:
Sub RemedyFormat()
'
' RemedyFormat Macro
' Macro recorded 5/13/2005 by aehrenwo
'
' Keyboard Shortcut: Ctrl+Shift+R
'
ActiveSheet.Name = "remedydata"
Sheets.Add
ActiveSheet.Name = "format"
Sheets("format").Move After:=Sheets(2)
Sheets("remedydata").Select
Columns("O:O").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveCell.FormulaR1C1 = "1"
Range("C1").Select
ActiveCell.FormulaR1C1 = "2"
Range("D1").Select
ActiveCell.FormulaR1C1 = "3"
Range("E1").Select
ActiveCell.FormulaR1C1 = "4"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5"
Range("G1").Select
ActiveCell.FormulaR1C1 = "6"
Range("H1").Select
ActiveCell.FormulaR1C1 = "7"
Range("I1").Select
ActiveCell.FormulaR1C1 = "8"
Range("J1").Select
ActiveCell.FormulaR1C1 = "9"
Range("K1").Select
ActiveCell.FormulaR1C1 = "10"
Range("P1").Select
ActiveCell.FormulaR1C1 = "11"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "12"
Range("R1").Select
ActiveCell.FormulaR1C1 = "13"
Range("S1").Select
ActiveCell.FormulaR1C1 = "14"
Range("T1").Select
ActiveCell.FormulaR1C1 = "15"
Range("U1").Select
ActiveCell.FormulaR1C1 = "16"
Range("V1").Select
ActiveCell.FormulaR1C1 = "17"
Range("W1").Select
ActiveCell.FormulaR1C1 = "18"
Range("X1").Select
ActiveCell.FormulaR1C1 = "19"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "20"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "21"
Range("AA1").Select
ActiveCell.FormulaR1C1 = "22"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "23"
Range("AC1").Select
ActiveCell.FormulaR1C1 = "24"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "25"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "26"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "27"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "28"
Range("AH1").Select
ActiveCell.FormulaR1C1 = "29"
Range("AI1").Select
ActiveCell.FormulaR1C1 = "30"
Range("AJ1").Select
ActiveCell.FormulaR1C1 = "31"
Range("AK1").Select
ActiveCell.FormulaR1C1 = "32"
Range("AL1").Select
ActiveCell.FormulaR1C1 = "33"
Range("AM1").Select
ActiveCell.FormulaR1C1 = "34"
Range("AN1").Select
ActiveCell.FormulaR1C1 = "35"
Range("AO1").Select
ActiveCell.FormulaR1C1 = "36"
Range("AP1").Select
ActiveCell.FormulaR1C1 = "37"
Range("AQ1").Select
ActiveCell.FormulaR1C1 = "38"
Range("AR1").Select
ActiveCell.FormulaR1C1 = "39"
Range("AS1").Select
ActiveCell.FormulaR1C1 = "40"
Range("AT1").Select
ActiveCell.FormulaR1C1 = "41"
Range("AU1").Select
ActiveCell.FormulaR1C1 = "42"
Range("AV1").Select
ActiveCell.FormulaR1C1 = "43"
Range("AW1").Select
ActiveCell.FormulaR1C1 = "44"
Range("AX1").Select
ActiveCell.FormulaR1C1 = "45"
Range("AY1").Select
ActiveCell.FormulaR1C1 = "46"
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "47"
Range("BA1").Select
ActiveCell.FormulaR1C1 = "48"
Range("BB1").Select
ActiveCell.FormulaR1C1 = "49"
Range("BC1").Select
ActiveCell.FormulaR1C1 = "50"
Range("BD1").Select
ActiveCell.FormulaR1C1 = "51"
Range("BE1").Select
ActiveCell.FormulaR1C1 = "52"
Range("BF1").Select
ActiveCell.FormulaR1C1 = "53"
Range("BG1").Select
ActiveCell.FormulaR1C1 = "54"
Range("BH1").Select
ActiveCell.FormulaR1C1 = "55"
Range("BI1").Select
ActiveCell.FormulaR1C1 = "56"
Range("BJ1").Select
ActiveCell.FormulaR1C1 = "57"
Range("BK1").Select
ActiveCell.FormulaR1C1 = "58"
Range("BL1").Select
ActiveCell.FormulaR1C1 = "59"
Range("BM1").Select
ActiveCell.FormulaR1C1 = "60"
Range("BN1").Select
ActiveCell.FormulaR1C1 = "61"
Range("BO1").Select
ActiveCell.FormulaR1C1 = "62"
Range("BP1").Select
ActiveCell.FormulaR1C1 = "63"
Range("BQ1").Select
ActiveCell.FormulaR1C1 = "64"
Range("BR1").Select
ActiveCell.FormulaR1C1 = "65"
Range("BS1").Select
ActiveCell.FormulaR1C1 = "66"
Range("BT1").Select
ActiveCell.FormulaR1C1 = "67"
Range("BU1").Select
ActiveCell.FormulaR1C1 = "68"
Range("BV1").Select
ActiveCell.FormulaR1C1 = "69"
Range("BW1").Select
ActiveCell.FormulaR1C1 = "70"
Range("BX1").Select
ActiveCell.FormulaR1C1 = "71"
Range("BY1").Select
ActiveCell.FormulaR1C1 = "72"
Range("BZ1").Select
ActiveCell.FormulaR1C1 = "73"
Range("CA1").Select
ActiveCell.FormulaR1C1 = "74"
Range("CB1").Select
ActiveCell.FormulaR1C1 = "75"
Range("CC1").Select
ActiveCell.FormulaR1C1 = "76"
Range("CD1").Select
ActiveCell.FormulaR1C1 = "77"
Range("CE1").Select
ActiveCell.FormulaR1C1 = "78"
Range("CF1").Select
ActiveCell.FormulaR1C1 = "79"
Range("CG1").Select
ActiveCell.FormulaR1C1 = "80"
Range("CH1").Select
ActiveCell.FormulaR1C1 = "81"
Range("CI1").Select
ActiveCell.FormulaR1C1 = "82"
Range("CJ1").Select
ActiveCell.FormulaR1C1 = "83"
Range("CK1").Select
ActiveCell.FormulaR1C1 = "84"
Range("CL1").Select
ActiveCell.FormulaR1C1 = "85"
Range("CM1").Select
ActiveCell.FormulaR1C1 = "86"
Range("CN1").Select
ActiveCell.FormulaR1C1 = "87"
Range("CO1").Select
ActiveCell.FormulaR1C1 = "88"
Range("CP1").Select
ActiveCell.FormulaR1C1 = "89"
Range("CQ1").Select
ActiveCell.FormulaR1C1 = "90"
Range("CS1").Select
Selection.NumberFormat = "m/d/yy"
Sheets("format").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Ticket#"
Range("B1").Select
ActiveCell.FormulaR1C1 = "BU"
Range("C1").Select
ActiveCell.FormulaR1C1 = "WWID"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Affiliate Reqestor"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Supplier#"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Supplier Name"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Category"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Type"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Item"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Document Type"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Invoice#"
Range("L1").Select
ActiveCell.FormulaR1C1 = "PO#"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Voucher#"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Check#"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Request Type"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Ticket Date"
Rows("1:1").Select
Range("C1").Activate
Selection.Font.Bold = True
Columns("D:D").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Cells.Select
Range("C1").Activate
Cells.EntireColumn.AutoFit
Columns("O:P").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
Sheets("remedydata").Select
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select
Range("CT2").Formula = "=CountA(B2:K2)"
Range("CT2").AutoFill Destination:=Range("CT2:CT" & Range("A2").End(xlDown).Row), Type:=xlFillDefault
Range("A2").Select
Dim RequestID
Dim RIDCell As String
Dim RowNum
Dim ColNum
Dim ASCol
Dim LastRowA
Dim LastRowB
Dim LastRowNow
Dim EntryNum
Dim BusRngNum1
Dim BusRngNum2
Dim LeftRng As String
Dim RightRng As String
Dim DataCol
Dim ActSearchNum As Integer
Dim CatNum As Integer
Dim TypeNum As Integer
Dim ItemNum As Integer
Dim DocNum As Integer
Dim InvNum As Integer
Dim PONum As Integer
Dim VouchNum As Integer
Dim CheckNum As Integer
LastRowA = Range("A65536").End(xlUp).Row
Do
Sheets("format").Activate
LastRowB = Range("A65536").End(xlUp).Row + 1
Sheets("remedydata").Activate
RowNum = ActiveCell.Row
ColNum = ActiveCell.Column
EntryNum = Cells(RowNum, 98).Value
RangeNum = LastRowB + EntryNum - 1
BusRngNum1 = ColNum + 1
BusRngNum2 = ColNum + EntryNum
ActiveCell.Copy
Sheets("format").Activate
Range("A" & LastRowB & ":A" & RangeNum).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
LeftRng = Cells(RowNum, BusRngNum1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
RightRng = Cells(RowNum, BusRngNum2).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Range(LeftRng & ":" & RightRng).Select
Selection.Copy
Sheets("format").Select
Range("B" & LastRowB).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = False
Sheets("remedydata").Activate
Cells(RowNum, ColNum).Activate
ActiveCell.Offset(0, 1).Activate
Do
HomeCell = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
ASCol = ActiveCell.Column
ActSearchNum = Cells(1, ASCol).Value
CatNum = ActSearchNum + 10
TypeNum = ActSearchNum + 20
ItemNum = ActSearchNum + 30
DocNum = ActSearchNum + 40
InvNum = ActSearchNum + 50
PONum = ActSearchNum + 60
VouchNum = ActSearchNum + 70
CheckNum = ActSearchNum + 80
'Category
Rows("1:1").Select
Selection.Find(What:=CatNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("I65536").End(xlUp).Row + 1
Range("I" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'Types
Rows("1:1").Select
Selection.Find(What:=TypeNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("J65536").End(xlUp).Row + 1
Range("J" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'Items
Rows("1:1").Select
Selection.Find(What:=ItemNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("K65536").End(xlUp).Row + 1
Range("K" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'DocNum
Rows("1:1").Select
Selection.Find(What:=DocNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("L65536").End(xlUp).Row + 1
Range("L" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'Invoices
Rows("1:1").Select
Selection.Find(What:=InvNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("M65536").End(xlUp).Row + 1
Range("M" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'PO #
Rows("1:1").Select
Selection.Find(What:=PONum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("N65536").End(xlUp).Row + 1
Range("N" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'Vouchers
Rows("1:1").Select
Selection.Find(What:=VouchNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("O65536").End(xlUp).Row + 1
Range("O" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'Checks
Rows("1:1").Select
Selection.Find(What:=CheckNum, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DataCol = ActiveCell.Column
Cells(RowNum, DataCol).Select
If ActiveCell.Value < 1 Then ActiveCell.Value = "X"
Selection.Copy
Sheets("format").Select
LastRowNow = Range("P65536").End(xlUp).Row + 1
Range("P" & LastRowNow).Select
ActiveSheet.Paste
Sheets("remedydata").Activate
'PROCEED ONTO LOOP
Range(HomeCell).Activate
ActiveCell.Offset(0, 1).Activate
Loop Until ActSearchNum = EntryNum
Sheets("remedydata").Select
Cells(RowNum, ColNum).Activate
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Row = LastRowA + 1
Sheets("format").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],remedydata!C[-2]:C[94], 12, FALSE)"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],remedydata!C[-3]:C[93], 13, FALSE)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],remedydata!C[-4]:C[92], 14, FALSE)"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],remedydata!C[-5]:C[91], 15, FALSE)"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],remedydata!C[-6]:C[90], 96, FALSE)"
Columns("H:H").Select
Selection.NumberFormat = "m/d/yy"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],remedydata!C[-7]:C[89], 97, FALSE)"
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
LastRowA = Range("A65536").End(xlUp).Row
Range("C2:H2").Select
Selection.AutoFill Destination:=Range("C2:H" & LastRowA), Type:=xlFillDefault
Cells.Select
Cells.EntireColumn.AutoFit
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Columns("C:F").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select
End Sub
Thanks,
KC