Code:
Sub Listare() ' Macro to format page for printing ------ GO AT THE BOTTOM TO CHOOSE IF YOU WANT TO PRINT DIRECTLY OR PREVIEW FIRST
Application.ScreenUpdating = False
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "C").End(xlUp).Row
' In cells E1 and D1 the values must be changed. My table will always be the same: 5 columns, starting from A1 to E1, variable
' length but never longer than about 250, always presorted ascending by column B
Range("A1").EntireRow.Insert
Range("A1").EntireRow.Insert
Range("A1").EntireRow.Insert
Range("D4").Select
ActiveCell.FormulaR1C1 = "Um"
ActiveCell.WrapText = False
Range("E4").Select
ActiveCell.FormulaR1C1 = "Cant"
ActiveCell.WrapText = False
Range("E4").HorizontalAlignment = xlRight
Columns("F").Insert shift:=xlToRight
Columns("F").ColumnWidth = 9
' Replace BUC with buc
ActiveSheet.Columns("D").Replace _
What:="BUC", Replacement:="buc", _
SearchOrder:=xlByColumns, MatchCase:=True
'Remove grey fill from row 1
'Range("A4:F4").Interior.ColorIndex = 0
'Delete duplicate entries in column 1
For rw = 279 To 5 Step -1
If Cells(rw, 1) = Cells(rw - 1, 1) Then
Cells(rw, 1).ClearContents
End If
Next
Columns("A").ColumnWidth = 10
' Columns("B").ColumnWidth = 20
' Columns("C").ColumnWidth = 43
Columns("D").ColumnWidth = 4
Columns("E").ColumnWidth = 10
Range("A4:A" & LastRow).Font.Size = 11 '13
Range("A4:A" & LastRow).Font.Name = "Arial Narrow" 'Tahoma
Range("B4:B" & LastRow).Font.Size = 11 '12
Range("B4:B" & LastRow).Font.Name = "Arial Narrow" 'Tahoma
Range("C:C").Font.Size = 11 '13
Range("C:C").Font.Name = "Tahoma"
Range("D4:D" & LastRow).Font.Size = 11 '13
Range("D4:D" & LastRow).Font.Name = "Arial Narrow"
Range("E4:E" & LastRow).Font.Size = 11 '13
Range("E4:E" & LastRow).Font.Name = "Arial Narrow"
End With
With ActiveSheet
' FIND EAN CODE FOR MATERIALS ------------------------- TONY VERSION
' Below code is to find EAN code into another excel file (export of ZNOMENCLATOR tcode from SAP), then merge it to
' column C next to the product name
'LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row
' Range("H5").Formula = "=INDEX([znomenclator.XLSX]Sheet1!$G:$G,MATCH(G5,[znomenclator.XLSX]Sheet1!$A:$A,0))"
' Range("H5").AutoFill Destination:=Range("H5:H" & LastRow)
' Range("I5").Formula = "=IF(ISNA(H5),C5,IF(H5="""",C5,C5&"" --- ""&H5))"
' Range("I5").AutoFill Destination:=Range("I5:I" & LastRow)
'Range("C5:C" & LastRow).Formula = Range("I5:I" & LastRow).Value
'Columns("G:M").EntireColumn.Delete
' FIND EAN CODE FOR MATERIALS ------------------------- DERBYDAD VERSION
' Below code is to find EAN code into another excel file (export of ZNOMENCLATOR tcode from SAP), then merge it to
' column C next to the product name
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "G").End(xlUp).Row
Range("H5:H" & LastRow).Formula = _
"=IFERROR(INDEX([znomenclator.XLSX]Sheet1!$G:$G,MATCH(G5,[znomenclator.XLSX]Sheet1!$A:$A,0)),"""")"
Range("I5:I" & LastRow).Formula = "=IF(H5=0,C5,C5&"" --- ""&H5)"
Range("C5:C" & LastRow) = Range("I5:I" & LastRow).Value
Range("G:I").EntireColumn.Delete
' CHANGE COLUMN C TITLE
Range("C4").Select
ActiveCell.FormulaR1C1 = "Denumire produs --- EAN"
ActiveCell.WrapText = False
End With
' INSERT 1 ROW ABOVE EACH COMPANY NAME IN COLUMN B
With ActiveSheet
Dim i, itotalrows As Integer
Dim strRange As String
itotalrows = ActiveSheet.Range("A300").End(xlUp).Offset(1, 0).Row
Do While i <= itotalrows
i = i + 1
strRange = "B" & i
strRange2 = "B" & i + 1
If Range(strRange).Text <> Range(strRange2).Text Then
Rows(i + 1).Insert
itotalrows = ActiveSheet.Range("A300").End(xlUp).Offset(1, 0).Row
i = i + 1
End If
Loop
Rows(1).EntireRow.Delete
End With
With ActiveSheet
' CLEAR DUPLICATES IN COLUMN B, EXCEPT FOR THEIR FIRST OCCURRENCE
For rw = 279 To 6 Step -1
If Cells(rw, 2) = Cells(rw - 1, 2) Then
Cells(rw, 2).ClearContents
End If
Next
' COPY COMPANY NAME AS TITLE FOR EACH SET OF ROWS FOLLOWING IT
Columns("B").Insert shift:=xlToRight
' Columns("B").ColumnWidth = 1
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row
Range("H5").FormulaLocal = "=IF(C6<>"""",C6,"""")"
Range("H5").AutoFill Destination:=Range("H5:H" & LastRow)
Range("I5").FormulaLocal = "=IF(A5<>"""","""",H5)"
Range("I5").AutoFill Destination:=Range("I5:I" & LastRow)
Range("B5:B" & LastRow) = Range("I5:I" & LastRow).Value
Columns("C:C").EntireColumn.Delete
Columns("G:H").EntireColumn.Delete
' MAKE COLUMN C AND COMPANY NAMES IN COLUMN B MORE VISIBLE
Range("B:B").Font.Size = 14 '13
Range("B:B").Font.Name = "Tahoma"
Range("B:B").Font.Bold = True
Columns("B").ColumnWidth = 0.05
Columns("C").ColumnWidth = 62
Range("C:C").WrapText = True
End With
' Add table borders for all cells with content.
With ActiveSheet.UsedRange.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Weight = xlThin
End With
' Page setup: A4, Portrait, Center horizontally, Zoom 100%.
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.LeftMargin = Application.CentimetersToPoints(0.296850393700787)
.RightMargin = Application.CentimetersToPoints(0.296850393700787)
.TopMargin = Application.CentimetersToPoints(0.393700787401575)
.BottomMargin = Application.CentimetersToPoints(0.393700787401575)
.HeaderMargin = Application.CentimetersToPoints(0.393700787401575)
.FooterMargin = Application.CentimetersToPoints(0.393700787401575)
.CenterHorizontally = True
.PaperSize = xlPaperA4
.Zoom = 100
.PrintTitleRows = "$1:1"
Range("A5:F5").Interior.ColorIndex = 0
End With
' ######################################################### -- PRINTING -- #########################################################
' Print preview or print directly (add ' in front of the line that you don't want to use and remove it from the other line)
' Worksheets("Sheet1").PrintPreview ' PRINT PREVIEW FIRST
ActiveSheet.PrintOut ' PRINT IMMEDIATELY ON DEFAULT PRINTER
' ###################################################################################################################################
Range("A1").Select
Application.ScreenUpdating = True
End Sub |
