I was having trouble creating a code to sort a range of names into four groups. Joe4 of this group helped me out by writing me a VBA code that works just fine. I was wanting to add this coding to another piece of VBA code I have that prints out the results in one step. Silly me, I thought it would be just a matter of adding the Macro into the code, but no matter how I try, I get a runtime error '1004'. When I click on debug, the "sort original data range is highlighted". Again, the code works fine stand alone, can't figure out what I'm doing wrong to not get it to work in the print coding.
Below is the VBA code I wrote to print out the ranges the names are sorted to. Please don't laugh to hard. The "MyCopyMacro" is the name of the macro Joe4 wrote for me. Probably needs to go somewhere else or it needs something additional. Thanks in advance for any help.
Private Sub cmdPrintBreakout_Click()
MyCopyMacro
With Sheet1
Application.PrintCommunication = False
With .PageSetup
.BottomMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0#)
.TopMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0#)
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.PrintArea = Sheet1.Range("CT5:CZ70").Address
.PrintArea = Sheet1.Range("DB5:DH70").Address
.PrintArea = Sheet1.Range("DJ5:DP70").Address
.PrintArea = Sheet1.Range("DR5:DX70").Address
End With
Application.PrintCommunication = True
Sheet1.Range("CT5:CZ70").PrintOut
Sheet1.Range("DB5:DH70").PrintOut
Sheet1.Range("DJ5:DP70").PrintOut
Sheet1.Range("DR5:DX70").PrintOut
End With
End Sub
This is the macro I am trying to get to work within the above code. The code in red is what is highlighted when I click on debug.
Sub MyCopyMacro()
Dim lr As Long
Dim sg As Long
Dim lg As Long
Dim i As Long
Dim lastLet
Dim lt As String
Dim fc As Long
Dim r As Long
Application.ScreenUpdating = False
lastLet = Array("G", "L", "R", "Z")
lr = Cells(Rows.Count, "CB").End(xlUp).Row
Range("CA8:CG" & lr).Sort Key1:=Range("CB8"), Order1:=xlAscending, Key2:=Range("CC8") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
i = 0 'initial group
sg = 9 'starting row of data grouping
fc = 98 'first column to paste to
lt = lastLet(i)
For r = 9 To lr
If Left(Cells(r, "CB"), 1) > lt Then
lg = r - 1
Range(Cells(sg, "CA"), Cells(lg, "CG")).Copy Cells(9, fc + (i * 8))
i = i + 1
lt = lastLet(i)
sg = r
End If
Next r
Range(Cells(sg, "CA"), Cells(lr, "CG")).Copy Cells(9, fc + (i * 8))
Application.ScreenUpdating = True
MsgBox "Complete!"
End Sub
Below is the VBA code I wrote to print out the ranges the names are sorted to. Please don't laugh to hard. The "MyCopyMacro" is the name of the macro Joe4 wrote for me. Probably needs to go somewhere else or it needs something additional. Thanks in advance for any help.
Private Sub cmdPrintBreakout_Click()
MyCopyMacro
With Sheet1
Application.PrintCommunication = False
With .PageSetup
.BottomMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0#)
.TopMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0#)
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.PrintArea = Sheet1.Range("CT5:CZ70").Address
.PrintArea = Sheet1.Range("DB5:DH70").Address
.PrintArea = Sheet1.Range("DJ5:DP70").Address
.PrintArea = Sheet1.Range("DR5:DX70").Address
End With
Application.PrintCommunication = True
Sheet1.Range("CT5:CZ70").PrintOut
Sheet1.Range("DB5:DH70").PrintOut
Sheet1.Range("DJ5:DP70").PrintOut
Sheet1.Range("DR5:DX70").PrintOut
End With
End Sub
This is the macro I am trying to get to work within the above code. The code in red is what is highlighted when I click on debug.
Sub MyCopyMacro()
Dim lr As Long
Dim sg As Long
Dim lg As Long
Dim i As Long
Dim lastLet
Dim lt As String
Dim fc As Long
Dim r As Long
Application.ScreenUpdating = False
lastLet = Array("G", "L", "R", "Z")
lr = Cells(Rows.Count, "CB").End(xlUp).Row
Range("CA8:CG" & lr).Sort Key1:=Range("CB8"), Order1:=xlAscending, Key2:=Range("CC8") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
i = 0 'initial group
sg = 9 'starting row of data grouping
fc = 98 'first column to paste to
lt = lastLet(i)
For r = 9 To lr
If Left(Cells(r, "CB"), 1) > lt Then
lg = r - 1
Range(Cells(sg, "CA"), Cells(lg, "CG")).Copy Cells(9, fc + (i * 8))
i = i + 1
lt = lastLet(i)
sg = r
End If
Next r
Range(Cells(sg, "CA"), Cells(lr, "CG")).Copy Cells(9, fc + (i * 8))
Application.ScreenUpdating = True
MsgBox "Complete!"
End Sub
