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
Columns("A:A").ColumnWidth = 3
Columns("H:H").ColumnWidth = 2.67
Range("J1").FormulaR1C1 = "V I. AZ."
Columns("J:J").ColumnWidth = 17
With Range("J1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Rows("1:1").Font.Bold = True
Columns("J:J").NumberFormat = "@"
With Columns("E:E")
.NumberFormat = "# ##0 [$Ft-hu-HU]"
.ColumnWidth = 20.11
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
Sheets("D_J_t_r_n").Name = "Ba_J"
ChDir "C:\ XXXXXXXXX \Desktop"
ActiveWorkbook.SaveAs Filename:="C:\XXXXX\XXXXXXXXX\Desktop\D_J_ba " & Format(Now(), "YYYYMMDD") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Checks if "po vi" exists in column C. If it doesn't, the macro ends.
If WorksheetFunction.CountIf(ActiveWorkbook.Sheets("Ba_J").Range("C:C"), "po vi") = 0 Then Exit Sub
'Highlight cells based on specific text (po_vi)
Dim r As Range, cel As Range
Set r = ActiveWorkbook.Sheets("Ba_J").Range("C2", ActiveWorkbook.Sheets("Ba_J").Range("C" & Rows.Count).End(xlUp))
For Each cel In r.Cells
If cel.Value = "po vi" Then
cel.Interior.ColorIndex = 6
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
'Move rows based on cell value ("po_vi")
Dim xRg As Range, xCell As Range, xCell As Range, A As Long, B As Long, 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
'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
'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 xWb
End Sub
Function wbname(MatchName As String) As String
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name Like MatchName Then
wbname = Wb.Name
Exit Function
End If
Next Wb
Wb Name = ""
End Function
