PDA

View Full Version : Block to write in cell



Borut
09-30-2021, 03:43 AM
Hello,

I have macro and modul



Private Sub VpisTurnusaD_Click()
Dim i As Integer
Application.ScreenUpdating = False
i = ActiveCell.Row
If Cells(i - 1, 39) = "error" Or Cells(i, 39) = "error" Then
MsgBox "workers missing"
Exit Sub
End If
If Cells(i - 1, 39).Value > 100000 Then
If ActiveCell.Column > 4 And ActiveCell.Column < 37 Then
If ActiveCell.Row = i Then
Call shift
Exit Sub
End If
End If
End If
MsgBox ("wrong cells")
Application.ScreenUpdating = True
End Sub


and modul:


Sub shift()
Dim o, j, h As Integer
Application.ScreenUpdating = False
myROW = ActiveCell.Row
myCOLUM = ActiveCell.Column
If IsEmpty(Worksheets("Podatki").Range("j19")) = True Then
MsgBox "Night hours before!"
Exit Sub
End If
If IsEmpty(Worksheets("Podatki").Range("k19")) = True Then
MsgBox "Night hours after!"
Exit Sub
End If
h = Day(DateSerial(Year(CDate(Worksheets("RAZPORED DELA").Cells(2, 4))), Month(CDate(Worksheets("RAZPORED DELA").Cells(2, 4))) + 1, 1) - 1)
h = h + 4
Worksheets("RAZPORED DELA").Range(Cells(myROW, myCOLUM), Cells(myROW, h)).ClearContents
Worksheets("RAZPORED DELA").Range(Cells(myROW, myCOLUM), Cells(myROW, h)).HorizontalAlignment = xlCenter
With Worksheets("RAZPORED DELA").Cells(myROW, myCOLUM)
Application.EnableEvents = False
For j = myCOLUM To h
o = myROW
Worksheets("RAZPORED DELA").Cells(o, j) = 12
Worksheets("RAZPORED DELA").Cells(o, j).HorizontalAlignment = xlCenter
j = j + 3
Next j
For j = myCOLUM + 1 To h
o = myROW
Worksheets("RAZPORED DELA").Cells(o, j) = Worksheets("Podatki").Range("j19")
Worksheets("RAZPORED DELA").Cells(o, j).HorizontalAlignment = xlRight
j = j + 3
Next j
For j = myCOLUM + 2 To h
o = myROW
Worksheets("RAZPORED DELA").Cells(o, j) = Worksheets("Podatki").Range("k19")
Worksheets("RAZPORED DELA").Cells(o, j).HorizontalAlignment = xlLeft
j = j + 3
Next j
Application.EnableEvents = True
End With
Worksheets("RAZPORED DELA").Cells(myROW, myCOLUM).Select
Application.ScreenUpdating = True
End Sub


when I run this macro, at the end, can not write value into cell. must press "delete" to delete value and then can write value in cell.
but this is not for all computer, and not for all office version (2013, 2016, 2019).
I can notfound out, whay in one computer block to write in cell and other works ok...

ideas?

Regards
Borut