Function wbname(MatchName As String) As String
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name Like Match Name Then
wbname = Wb.Name
Exit Function
End If
Next Wb
Wb Name = ""
End Function
Sub RunAll()
Application.DisplayAlerts = False
Columns("A:A").Select
Selection.TextToColumns Destination:=range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
range("A2").Select
Columns("A:A").ColumnWidth = 3
Columns("H:H").ColumnWidth = 2.67
range("J1").Select
ActiveCell.FormulaR1C1 = "V I. AZ."
Columns("J:J").ColumnWidth = 17
range("J1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("1:1").Select
Selection.Font.Bold = True
Columns("J:J").Select
Selection.NumberFormat = "@"
Columns("E:E").Select
Selection.NumberFormat = "# ##0 [$Ft-hu-HU]"
Selection.ColumnWidth = 20.11
range("B2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Sheets("D_J_t_r_n").Name = "Ba_J"
range("B2").Select
ChDir "C:\ XXXXXXXXX \Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\XXXXX\XXXXXXXXX\Desktop\D_J_ba " & Format(Now(), "YYYYMMDD") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Highlight cells based on specific text (po_vi)
Dim r As range
V = "po vi"
Set r = ActiveWorkbook.Worksheets("Ba_J").UsedRange
For Each cell In r.Cells
If cell.Value = V Then
cell.Interior.Color = 65535
End If
Next
'Count the quantity for today
Dim x As Integer
x = Cells(Rows.count, 2).End(xlUp).Row
MsgBox "XXXXXXXXXXXXXX: " & (x - 1)
'end if - here i need the stoping code if there are no yellow cells in column C or based on specific text no “po-vi“, if the cells contains any of it in column C run the rest
'Create a "Po_J" sheet with freezed top row
Dim ws As Worksheet
Set ws = Sheets("Ba_J") '<< copy row1 from "Ba_J"
Dim h As Double
h = ws.Cells(1, 1).RowHeight
Sheets.Add After:=ws
ActiveSheet.Name = "Po_J"
ws.Rows("1:1").Copy
With ActiveSheet
.Paste
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
.Cells(1, 1).RowHeight = h
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
[A1].Select
'Move rows based on cell value ("po_vi")
Dim xRg As range
Dim xCell As range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Ba_J").UsedRange.Rows.count
B = Worksheets("Po_J").UsedRange.Rows.count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Po_J").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("B_J").range("C1:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.count
If CStr(xRg(C).Value) = "po_vi" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Po_J").range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Desktop\D_J_po " & Format(Now, "YYYYMMDD") & ".xlsx" _
, FileFormat:=51, CreateBackup:=False
[A2].Select
'Move Sheet to D_J_po
D_J_po = wbname("D_J_po *")
D_J_ba = wbname("D_J_ba *")
Windows(D_J_ba).Activate
Sheets("Po_J").Move Before:=Workbooks(D_J_po).Sheets(1)
'Sheets("Po_J").Copy Before:=Workbooks(D_J_po).Sheets(1)
'Windows(D_J_ba).Activate SaveChanges:=True
D_J_b = wbname("D_J_ba *")
Windows(D_J_ba).Activate
Columns("A:A").Select
For i = Selection.Rows.count To 1 Step -1
If Cells(i, 3).Value = "p_vu " Then
Cells(i, 3).EntireRow.Delete
End If
Next i
[A1].Select
'Save All open Workbooks
Dim xWb As Workbook
For Each xWb In Application.Workbooks
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
xWb.Save
End If
Next
End Sub
