adding code to an existing macro

[jazzD]

hi all,
i have a macro set up which works great and i want to add the below code to it, i know where i need it to fit in but i dont know how to get it to work after

Sub MonthlySpreadsheetJanuary()
Dim List As Variant
Dim LR As Long
Dim r As Long
List = Array("Cash Movement")
LR = Range("C" & Rows.Count).End(xlUp).Row
For r = LR To 2 Step -1
    If IsError(Application.Match(Range("C" & r).Value, List, False)) Then
        Rows(r).Delete
    End If
Next r
End Sub

any advice?

 

[Fluff]

Are you saying the posted code doesn't work, or that you don't know how to add it to another macro?

 

[jazzD]

i dont know how to add it to another macro - it needs to go in in the middle of existing code!

 

[Fluff]

In that case can you please post the code you want to add this to, indicating where it should go.

When posting code please use code tags, the # icon in the reply window. Also please ensure the formatting is correct rather than all the code on one line.

 

[jazzD]

In that case can you please post the code you want to add this to, indicating where it should go.

When posting code please use code tags, the # icon in the reply window. Also please ensure the formatting is correct rather than all the code on one line.

ok here you go, im really amateur at this but hopefully it works, i have highlighed in red where i want it to go just below that line. thank you.

  Range("A1:V3").Select
    Selection.EntireRow.Delete
    Cells.Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    [COLOR=#ff0000]End With[/COLOR]
    Range("A:A,C:C,D:D,G:G,H:H,J:J").Select
    Range("J1").Activate
    Range("A:A,C:C,D:D,G:G,H:H,J:J,K:K,L:L,O:V").Select
    Range("O1").Activate
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("F:F").Select
    Selection.Style = "Currency"
    Cells.Select
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Add Key:=Range("B2:B36") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Add Key:=Range("A2:A36") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet0").Sort
        .SetRange Range("A1:V36")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Font.Size = 11
    Selection.Font.Size = 12
    Selection.Font.Size = 14
    Selection.Font.Size = 16
    Dim lr As Long
    Dim r As Long
    Dim sr As Long
    Dim sc As String
   
'***************************************************
'   Specifiy the column you wish to apply this to
    sc = "B"
'   Specify first row of data
    sr = 2
'***************************************************
   
    Application.ScreenUpdating = False
   
'   Find last row with data
    lr = Cells(Rows.Count, sc).End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To (sr + 1) Step -1
'       Insert row if cell is different than cell above
        If Cells(r, sc) <> Cells(r - 1, sc) Then Rows(r).Insert
    Next r
   
    Application.ScreenUpdating = True
   
 
End Sub

 

[Fluff]

Ok, try

    Dim List As Variant
    Dim lr As Long
    Dim r As Long

    Range("A1:V3").Select
    selection.EntireRow.Delete
    Cells.Select
    With selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    List = Array("Cash Movement")
    lr = Range("C" & Rows.Count).End(xlUp).Row
    For r = lr To 2 Step -1
        If IsError(Application.Match(Range("C" & r).Value, List, False)) Then
            Rows(r).Delete
        End If
    Next r

    Range("A:A,C:C,D:D,G:G,H:H,J:J").Select
    Range("J1").Activate
    Range("A:A,C:C,D:D,G:G,H:H,J:J,K:K,L:L,O:V").Select
    Range("O1").Activate
    selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("F:F").Select
    selection.Style = "Currency"
    Cells.Select
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Add Key:=Range("B2:B36") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet0").Sort.SortFields.Add Key:=Range("A2:A36") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet0").Sort
        .SetRange Range("A1:V36")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Select
    selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    selection.Font.Size = 11
    selection.Font.Size = 12
    selection.Font.Size = 14
    selection.Font.Size = 16
    Dim lr As Long
    Dim r As Long
    Dim sr As Long
    Dim sc As String
   
'***************************************************
'   Specifiy the column you wish to apply this to
    sc = "B"
'   Specify first row of data
    sr = 2
'***************************************************
   
    Application.ScreenUpdating = False
   
'   Find last row with data
    lr = Cells(Rows.Count, sc).End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To (sr + 1) Step -1
'       Insert row if cell is different than cell above
        If Cells(r, sc) <> Cells(r - 1, sc) Then Rows(r).Insert
    Next r
   
    Application.ScreenUpdating = True
   
 
End Sub

 

[jazzD]

Thank you! its giving me lots of different errors but i need to shut down my computer now so will try it again after and see what happens!