How do I make the 2nd macro execute the formatting and pasting on the subsequent values that is added by the 1st macro.

S

Smilin

Board Regular
Joined
Nov 28, 2019
Messages
67
Platform
  1. Windows
I have 2 macros, “hailshort” and “sort”

Hail short will updated my master sheet with 16 lines, pasting under the last row.

My “sort” macro is designed to sort and format the 16 lines that get posted. However, it doesn’t execute the formatting on the 2nd set of 16 lines. It will do it on the 1st 16 lines of my master sheet as that is where I created the macro, but it wont format/sort the 2nd set of 16 lines. I tried combining the two macros but it doesn’t work.

The 2 macros are:
Sub hailshort()
'define source range
Dim Lastrow As Long

With Worksheets("Macro")
Lastrow = .Range("E" & Rows.Count).End(xlUp).Row + 1
Worksheets("hail").Range("N2:N17").Copy
.Range("C" & Lastrow).PasteSpecial Paste:=xlValues

Worksheets("hail").Range("C2:C17").Copy
.Range("D" & Lastrow).PasteSpecial Paste:=xlValues

Worksheets("hail").Range("E2:E17").Copy
.Range("E" & Lastrow).PasteSpecial Paste:=xlValues

Worksheets("hail").Range("D2:D17").Copy
.Range("F" & Lastrow).PasteSpecial Paste:=xlValues
End With
End Sub
____________________________________________________________
Sub sort()
'
' sort Macro
Range("J2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "x"
Range("J4").Select
ActiveCell.FormulaR1C1 = "x"
Range("J6").Select
ActiveCell.FormulaR1C1 = "x"
Range("J8").Select
ActiveCell.FormulaR1C1 = "x"
Range("J10").Select
ActiveCell.FormulaR1C1 = "x"
Range("J12").Select
ActiveCell.FormulaR1C1 = "x"
Range("J14").Select
ActiveCell.FormulaR1C1 = "x"
Range("J16").Select
ActiveWindow.SmallScroll Down:=-18
Range("J16").Select
ActiveCell.FormulaR1C1 = "x"
Columns("C:J").Select
ActiveWorkbook.Worksheets("Macro").sort.SortFields.Clear
ActiveWorkbook.Worksheets("Macro").sort.SortFields.Add2 Key:=Range("J2:J18") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Macro").sort
.SetRange Range("C1:J18")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C2:I17").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Range("J2:J9").Select
Selection.ClearContents
Range("D2:D17").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 2
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("F2:F17").Select
Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####"
Range("H2:H17").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("B2").Select
ActiveCell.FormulaR1C1 = "8:00 AM"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B5"), Type:=xlFillDefault
Range("B2:B5").Select
Range("B6").Select
ActiveCell.FormulaR1C1 = "1:00 PM"
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B9"), Type:=xlFillDefault
Range("B6:B9").Select
Range("B2:B9").Select
Selection.Copy
Range("B10").Select
ActiveSheet.Paste
Range("B2:G9").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15071487
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B10:G17").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15648990
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("E21").Select
Range("A2:A9").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15071487
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A10:A17").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15648990
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("E25").Select
End Sub

How do I make the 2nd macro execute the formatting and pasting on each subsequent values that is added by the 1st macro? Can you help?
 
Sort by date Sort by votes

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
@Smilin First off you shouldn't ever mark a 'You are welcome' post as a solution to your dilemma that you were inquiring about, that helps nobody else that reads this in the future. ;)

Second, I'm not done playing yet. I want to relook at the code and address your 'border' issue as well as some clean up, if you don't mind.
 
Upvote 0
johnnyL said:
@Smilin First off you shouldn't ever mark a 'You are welcome' post as a solution to your dilemma that you were inquiring about, that helps nobody else that reads this in the future. ;)

Second, I'm not done playing yet. I want to relook at the code and address your 'border' issue as well as some clean up, if you don't mind.
Click to expand...
Hi Johnny.. yes I m confused about where to say thank you. Even now not sure if I m doing it correctly. The border is correct now. However if you want to play:
I have a workshheet with 5 tabs. I want to run the macro you worked so hard on from any of the tabs . So I know the path would be from hail to “this sheet”. But I m ok to copy the populated data to each tab as needed .
 
Upvote 0
How did you correct the border issue? Do you need to upload a new version with corrections that we can see where you are now in your path to enlightenment?
 
Upvote 0
Here you go, borders cleaned up and code shortened up a little more also.

VBA Code: 
    Public LastrowPlus1 As Long


Sub hailshort()
'
'   define source range
'
    With Worksheets("Macro")
        LastrowPlus1 = .Range("E" & Rows.Count).End(xlUp).Row + 1           ' Find LastRow of Column E on 'Macro' sheet and add 1 to the count
'
        Worksheets("hail").Range("N2:N17").Copy                             ' Copy N2:N17 from 'hail' sheet to 'macro' sheet Column C LastRowPlus1
        .Range("C" & LastrowPlus1).PasteSpecial Paste:=xlValues
'
        Worksheets("hail").Range("C2:C17").Copy                             ' Copy C2:C17 from 'hail' sheet to 'macro' sheet Column D LastRowPlus1
        .Range("D" & LastrowPlus1).PasteSpecial Paste:=xlValues
'
        Worksheets("hail").Range("E2:E17").Copy                             ' Copy E2:E17 from 'hail' sheet to 'macro' sheet Column E LastRowPlus1
        .Range("E" & LastrowPlus1).PasteSpecial Paste:=xlValues
'
        Worksheets("hail").Range("D2:D17").Copy                             ' Copy D2:D17 from 'hail' sheet to 'macro' sheet Column F LastRowPlus1
        .Range("F" & LastrowPlus1).PasteSpecial Paste:=xlValues
    End With
'
    Call sort
End Sub

Sub sort()
'
' sort Macro
'
    Application.CutCopyMode = False
'
    For RowOffset = LastrowPlus1 To LastrowPlus1 + 14 Step 2
        Range("J" & RowOffset) = "x"
    Next
'
    ActiveWorkbook.Worksheets("Macro").sort.SortFields.Clear
'
    ActiveWorkbook.Worksheets("Macro").sort.SortFields.Add Key:=Range("J" & LastrowPlus1 & ":J" & LastrowPlus1 + 16), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
'
    With ActiveWorkbook.Worksheets("Macro").sort
        .SetRange Range("C" & LastrowPlus1 - 1 & ":J" & LastrowPlus1 + 16)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'
    Range("K" & LastrowPlus1 & ":K" & LastrowPlus1 + 15).Borders.LineStyle = xlNone             ' Fix Column K borders
'
    Range("J" & LastrowPlus1 & ":J" & LastrowPlus1 + 7).ClearContents
'
    With Range("D" & LastrowPlus1 & ":D" & LastrowPlus1 + 15)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 2
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'
    Range("F" & LastrowPlus1 & ":F" & LastrowPlus1 + 15).NumberFormat = "[<=9999999]###-####;(###) ###-####"
'
    With Range("H" & LastrowPlus1 & ":H" & LastrowPlus1 + 15).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
    End With
'
    Range("B" & LastrowPlus1).Select
    ActiveCell.FormulaR1C1 = "8:00 AM"
    Range("B" & LastrowPlus1).AutoFill Destination:=Range("B" & LastrowPlus1 & ":B" & LastrowPlus1 + 3), Type:=xlFillDefault
'
    Range("B" & LastrowPlus1 + 4).Select
    ActiveCell.FormulaR1C1 = "1:00 PM"
    Range("B" & LastrowPlus1 + 4).AutoFill Destination:=Range("B" & LastrowPlus1 + 4 & ":B" & LastrowPlus1 + 7), Type:=xlFillDefault
'
    Range("B" & LastrowPlus1 + 4 & ":B" & LastrowPlus1 + 7).Select
    Range("B" & LastrowPlus1 & ":B" & LastrowPlus1 + 7).Copy
'
    Range("B" & LastrowPlus1 + 8).Select
    ActiveSheet.Paste
'
    Application.CutCopyMode = False
'
    With Range("B" & LastrowPlus1 & ":G" & LastrowPlus1 + 7).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15071487
    End With
'
    With Range("B" & LastrowPlus1 + 8 & ":G" & LastrowPlus1 + 15).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15648990
    End With
'
    Range("E" & LastrowPlus1 + 19).Select
    With Range("A" & LastrowPlus1 & ":A" & LastrowPlus1 + 7).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15071487
    End With
'
    With Range("A" & LastrowPlus1 + 8 & ":A" & LastrowPlus1 + 15).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15648990
    End With
'
    Set CellRangeToAddBordersTo = Range("A" & LastrowPlus1 & ":I" & LastrowPlus1 + 15)
'
    For Each Cel In CellRangeToAddBordersTo
        With Cel.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .Weight = xlThin
        End With
'
        With Cel.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .Weight = xlThin
        End With
'
        With Cel.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .Weight = xlThin
        End With
'
        With Cel.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .Weight = xlThin
        End With
    Next
'
    Range("E" & LastrowPlus1 + 23).Select
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
324
Micron
M
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
598
RoryA
RoryA
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
379
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,224,760
Messages
6,180,816
Members
452,996
Latest member
nelsonsix66

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