privatemoon
New Member
- Joined
- Feb 15, 2013
- Messages
- 42
- Office Version
- 365
- Platform
- Windows
Hi, I'm having some trouble combining a few macros together. Here's the original macro:
And here is the code (with the previous macro):
The problem is the macros that come after the original macro doesn't run if there aren't any duplicates/matches. If anyone could help me solve this problem, I'd greatly appreciate it!
Code:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub Macro1()
'Credits to mehmetcik
LR = Cells(Rows.Count, 20).End(xlUp).Row
Range("AS2:AS" & LR).FormulaR1C1 = _
"=IF(AND(RC[-25]=R[1]C[-25],RC[-24]=R[1]C[-24]),1,"""")"
Range("AS2:AS" & LR).Value = Range("AS2:AS" & LR).Value
With Range("AS2:AS" & LR)
Set rngFind = .Find(1, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngPicked = rngFind
Do
Set rngPicked = Union(rngPicked, rngFind)
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
End If
End With
If strFirstAddress = "" Then Exit Sub
rngPicked.Select
For Each c In Selection
Range("AD" & c.Row & ":AR" & c.Row).Copy Range("AD" & c.Row + 1 & ":AR" & c.Row + 1)
Next
Range("AS2:AS" & LR).Clear
Range("A1").Select
End Sub</code>
And here is the code (with the previous macro):
Code:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub EE4_Macro1()
'Delete Payment Pending people
With ActiveSheet
.AutoFilterMode = False
With Range("G1", Range("G" & Rows.Count).End(xlUp))
.AutoFilter 1, "Pending Payment"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
'Copies information across rows if duplicate name found
LR = Cells(Rows.Count, 20).End(xlUp).Row
Range("AS2:AS" & LR).FormulaR1C1 = _
"=IF(AND(RC[-25]=R[1]C[-25],RC[-24]=R[1]C[-24]),1,"""")"
Range("AS2:AS" & LR).Value = Range("AS2:AS" & LR).Value
With Range("AS2:AS" & LR)
Set rngFind = .Find(1, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not rngFind Is Nothing Then
strFirstAddress = rngFind.Address
Set rngPicked = rngFind
Do
Set rngPicked = Union(rngPicked, rngFind)
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
End If
End With
If strFirstAddress = "" Then Exit Sub
rngPicked.Select
For Each c In Selection
Range("AD" & c.Row & ":AR" & c.Row).Copy Range("AD" & c.Row + 1 & ":AR" & c.Row + 1)
Next
Range("AS2:AS" & LR).Clear
Range("A1").Select
'Sort by event, then last name
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2:A300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveSheet.Sort
.SortFields.Add Key:=Range("U2:U300"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:AZ300")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End With
'Format row height
Cells.Select
Selection.RowHeight = 13.5
'Convert file from CSV to XLSX
With ActiveWorkbook
.SaveAs Left(.FullName, InStr(.FullName, ".")) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End With
End Sub</code>
The problem is the macros that come after the original macro doesn't run if there aren't any duplicates/matches. If anyone could help me solve this problem, I'd greatly appreciate it!