AdrianK
06-10-2009, 09:30 AM
Hello All,
I'm currently working on a macro to format some information from an invoicing system, moving the details to different sheets depending on payment status, which is fine.
I am having a mental block with the next section of my project, where I need to move all rows, where there are multiple invoices for a purchase order number, to a seperate sheet.
The purchase order number is in column A, and for each one where there is > 1 row with this number I need to move all rows with that value in column A to a the new sheet.
I was thinking maybe advanced filtering (for unique records), copying to an array and then counting, but to be honest I am not really sure where to start. :banghead:
Purchase order numbers contain numbers and letters so would need to be stored as a string.
Any help would be most appreciated.
I have included what I have so far below.
Many thanks,
Adrian
Sub FINANCE_Format()
Dim intFINALROW As Integer
Dim arrFILTERS(1 To 5) As String
Dim intARRAY As Integer
arrFILTERS(1) = "Invoice Paid"
arrFILTERS(2) = "Ready for Payment"
arrFILTERS(3) = "On FINANCE - Not on Remittance"
arrFILTERS(4) = "Registered but not Ready"
arrFILTERS(5) = "POs with Multiple Invs"
intFINALROW = ActiveSheet.UsedRange.Rows.Count
Sheets(1).Name = "FINANCE"
' Add autofilter if it's not there
If ActiveSheet.AutoFilterMode = False Then
Rows(1).AutoFilter
End If
' Format sheet/header
Range("A2").Select
ActiveWindow.freezepanes = True
Cells.EntireColumn.AutoFit
Range("A1:U1").Font.Bold = True
Range("U:U").Select
' Replace incorrect terminology
Selection.Replace What:="Processed through FINANCE, but not on Remittance Advice - Cancelled??", _
Replacement:="On FINANCE - Not on Remittance", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Registered, but not ready for payment", _
Replacement:="Registered but not Ready", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Loop through first 4 array elements creating the tabs
For intARRAY = 1 To 4
Selection.AutoFilter field:=21, Criteria1:=arrFILTERS(intARRAY)
Sheets.Add.Name = arrFILTERS(intARRAY)
Sheets(arrFILTERS(intARRAY)).Move Before:=Sheets("FINANCE")
Sheets("FINANCE").Range("A1:U" & intFINALROW + 3).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets(arrFILTERS(intARRAY)).Range("A1")
Cells.EntireColumn.AutoFit
Sheets("FINANCE").Select
Next intARRAY
Sheets("FINANCE").Select ' Select sheet
Selection.AutoFilter field:=21 ' Remove filter
' Create tab for lines where there is more than one invoice per PO number
Sheets.Add.Name = arrFILTERS(5)
End Sub
I'm currently working on a macro to format some information from an invoicing system, moving the details to different sheets depending on payment status, which is fine.
I am having a mental block with the next section of my project, where I need to move all rows, where there are multiple invoices for a purchase order number, to a seperate sheet.
The purchase order number is in column A, and for each one where there is > 1 row with this number I need to move all rows with that value in column A to a the new sheet.
I was thinking maybe advanced filtering (for unique records), copying to an array and then counting, but to be honest I am not really sure where to start. :banghead:
Purchase order numbers contain numbers and letters so would need to be stored as a string.
Any help would be most appreciated.
I have included what I have so far below.
Many thanks,
Adrian
Sub FINANCE_Format()
Dim intFINALROW As Integer
Dim arrFILTERS(1 To 5) As String
Dim intARRAY As Integer
arrFILTERS(1) = "Invoice Paid"
arrFILTERS(2) = "Ready for Payment"
arrFILTERS(3) = "On FINANCE - Not on Remittance"
arrFILTERS(4) = "Registered but not Ready"
arrFILTERS(5) = "POs with Multiple Invs"
intFINALROW = ActiveSheet.UsedRange.Rows.Count
Sheets(1).Name = "FINANCE"
' Add autofilter if it's not there
If ActiveSheet.AutoFilterMode = False Then
Rows(1).AutoFilter
End If
' Format sheet/header
Range("A2").Select
ActiveWindow.freezepanes = True
Cells.EntireColumn.AutoFit
Range("A1:U1").Font.Bold = True
Range("U:U").Select
' Replace incorrect terminology
Selection.Replace What:="Processed through FINANCE, but not on Remittance Advice - Cancelled??", _
Replacement:="On FINANCE - Not on Remittance", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Registered, but not ready for payment", _
Replacement:="Registered but not Ready", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Loop through first 4 array elements creating the tabs
For intARRAY = 1 To 4
Selection.AutoFilter field:=21, Criteria1:=arrFILTERS(intARRAY)
Sheets.Add.Name = arrFILTERS(intARRAY)
Sheets(arrFILTERS(intARRAY)).Move Before:=Sheets("FINANCE")
Sheets("FINANCE").Range("A1:U" & intFINALROW + 3).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets(arrFILTERS(intARRAY)).Range("A1")
Cells.EntireColumn.AutoFit
Sheets("FINANCE").Select
Next intARRAY
Sheets("FINANCE").Select ' Select sheet
Selection.AutoFilter field:=21 ' Remove filter
' Create tab for lines where there is more than one invoice per PO number
Sheets.Add.Name = arrFILTERS(5)
End Sub