adding code to an existing macro

J

jazzD

New Member
Joined
May 3, 2019
Messages
18
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

Code: 
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?
 
Last edited by a moderator:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Are you saying the posted code doesn't work, or that you don't know how to add it to another macro?
 
Upvote 0
i dont know how to add it to another macro - it needs to go in in the middle of existing code!
 
Upvote 0
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.
 
Upvote 0
Fluff said:
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.
Code: 
  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
Click to expand...
 
Upvote 0
Ok, try
Code: 
    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
 
Upvote 0
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!
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question Question
VBA Code for Named Ranges
Replies
2
Views
626
fishandtril
F
M
  • Solved
run formula based on cell value to the last row
Replies
5
Views
381
MMM_84
M
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
731
Alex Blakenburg
A
K
  • Solved
Using VBA to select a color coded cell
2
Replies
11
Views
926
Alex Blakenburg
A
M
  • Solved
VBA macro: How to identify column by name (instead of number) before filling
Replies
3
Views
1K
rpaulson
rpaulson

Forum statistics

Threads
1,223,761
Messages
6,174,347
Members
452,556
Latest member
Chrisolowolafe

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top