Filling random values in two sheets from a single sheet via Excel VBA

Question

I fill out random values in two sheets (Testfall-Input_Vorschlag) and (Testfall-Input_Antrag) out of another sheet (ADMIN_ARB11).

I have 371 rows in sheet (Testfall-Input_Vorschlag) and I have 488 rows in sheet (Testfall-Input_Antrag). I have 859 columns in sheet (ADMIN_ARB11).

I pick a random value from each of the 1st 371 columns (from ADMIN_ARB11) and I put them in the 371 rows in sheet (Testfall-Input_Vorschlag) and then I pick a random value from each of the next 488 columns (from ADMIN_ARB11) and put them in 488 rows in sheet (Testfall-Input_Antrag).

Sub Random_Befüllung_Vorschlag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Set sh1 = Sheets("Testfall-Input_Vorschlag")
Set sh2 = Sheets("ADMIN_ARB11")
Application.ScreenUpdating = False
 For j = 7 To 300
 LB = 2
 If sh1.Cells(1, j) = "ARB11" Or sh1.Cells(1, j) = "ARB13" Or sh1.Cells(1, j) = "FVB1" Or sh1.Cells(1, j) = "FVB1E" Or sh1.Cells(1, j) = "FVB4" Or sh1.Cells(1, j) = "FVB4E" Then
 sh1.Cells(2, j) = sh1.Cells(1, j) & "_Schicht 1"
 sh1.Cells(3, j) = "TPL maximale Eingaben"
 If j = 7 Then
 sh1.Cells(6, j) = 1
 Else
 sh1.Cells(6, j) = sh1.Cells(6, j - 1) + 1
 End If
 sh1.Cells(5, j) = "TF " & sh1.Cells(6, j)
 sh1.Cells(7, j) = "Test_GE"
 sh1.Cells(8, j) = "x"
 For i = 11 To 382
 UB = sh2.Cells(Rows.Count, i - 10).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
 sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i - 10)
 Next
 End If
 If sh1.Cells(1, j) = vbNullString Then
 Exit For
 End If
 Next
Application.ScreenUpdating = False
End Sub
Sub Random_Befüllung_Antrag_ARB11()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long, LB As Long, UB As Long
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("Testfall-Input_Vorschlag")
Set sh1 = Sheets("Testfall-Input_Antrag")
Set sh2 = Sheets("ADMIN_ARB11")
Application.ScreenUpdating = False
 'Testfallinfo in Testfall-Input_Antrag kopieren
 For j = 7 To 300
 If Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB11" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB13" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1E" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4E" Then
 Union(ws.Cells(1, j), ws.Cells(2, j), ws.Cells(3, j), ws.Cells(4, j), ws.Cells(5, j), ws.Cells(6, j), ws.Cells(7, j), ws.Cells(8, j)).Copy
 sh1.Range("IV1").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
 End If
 LB = 2
 If sh1.Cells(1, j) = "ARB11" Then
 For i = 13 To 501
 UB = sh2.Cells(Rows.Count, i + 364).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
 sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i + 364)
 Next
 End If
 If sh1.Cells(1, j) = vbNullString Then
 Exit For
 End If
 Next j
Application.ScreenUpdating = True
End Sub

It works as expected but it takes 5 min to run the code. How can I optimize this?

Answer 1

Accessing Objects such as Sheets, Cells & Range takes considerable time. Try to reduce their use as much as you can by assigning their values to a variable before entering a For loop.

If Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB11" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "ARB13" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB1E" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4" Or Sheets("Testfall-Input_Vorschlag").Cells(1, j) = "FVB4E" Then

These chained If statements will each be getting the value of your test cell in turn, each one accessing Sheets and Cells individually over and over for the same value, this will likely be having an impact on your performance.

Try putting the cell value in a variable before your tests:

testCell = Sheets("Testfall-Input_Vorschlag").Cells(1, j).Value
If testCell = "ARB11" Or testCell = "ARB13" Or testCell = "FVB1" Or testCell = "FVB1E" Or testCell = "FVB4" Or testCell = "FVB4E" Then

---

For i = 13 To 501
 UB = sh2.Cells(Rows.Count, i + 364).End(xlUp).Row 'i - 10 controls column in Admin start at col 1.
 sh1.Cells(i, j).Value = sh2.Cells(Int((UB - LB + 1) * Rnd + LB), i + 364)
Next

Within this loop, it appears that each iteration is finding the bottom row number with UB = sh2.Cells(Rows.Count, i + 364).End(xlUp).Row, could this be done before the loop?