Hi,
I have a hard time trying to understand what is wrong with my code. When I type "1" in the input box everything works but for the other 2 options "2" and "3" VBA does not execute the sheets.add (marked in red and bolded) line leading to an error in the following line (underlined) where a newly added sheet is used. Options "1","2" and "3" are divided by " '_______________________________________ ".
Appreciate any help.
I have a hard time trying to understand what is wrong with my code. When I type "1" in the input box everything works but for the other 2 options "2" and "3" VBA does not execute the sheets.add (marked in red and bolded) line leading to an error in the following line (underlined) where a newly added sheet is used. Options "1","2" and "3" are divided by " '_______________________________________ ".
Appreciate any help.
VBA Code:
Option Explicit
Sub T_formuly()
Application.ScreenUpdating = False
Dim PerfWB, OblWB, SOL3WB As Workbook
Dim PerfSH, OblSH, SOL3WS, WynSH As Worksheet
Dim A1SH, A2SH As Worksheet
Dim rngCal As Range
Dim lastRow&, nextRow&, nextColumn&, lastColumn&
Dim AvrVal&
Dim Lower, Upper As Variant
Dim n&, i&, k&, x&, y&, ev&, odd&
Dim inpSkid$, SkidName$
Dim DataSH As Worksheet
Dim PivSH As Worksheet
Dim PivCache As PivotCache
Dim PivTab As PivotTable
Dim PivRange As Range
Upper = CDec(1.5)
Lower = CDec(0.5)
Set OblWB = ActiveWorkbook
Set OblSH = OblWB.Sheets("Obliczenia")
Set WynSH = OblWB.Sheets("Wynik")
line_1:
inpSkid = InputBox(vbCrLf & "1 - Soleri 3" & vbCrLf & "2 - Tetra 4" & _
vbCrLf & "3 - Tetra 6" & vbCrLf & "" & vbCrLf & "4 - Wszystkie" & vbCrLf, "Test_inpSkid")
If StrPtr(inpSkid) = 0 Then
Exit Sub
ElseIf inpSkid = "1" Then
SkidName = "Soleri 3"
Set PerfWB = Workbooks.Open _
("x:\Performance.xls", True, True)
Set PerfSH = PerfWB.Sheets("PerformanceReport")
lastRow = PerfSH.Cells(Rows.Count, "O").End(xlUp).Row
nextRow = OblSH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = OblSH.Cells(2, Columns.Count).End(xlToLeft).Column
n = 1
For k = 2 To lastRow
If PerfSH.Range("E" & k).Text = "SOLERI3" Then
If k = 2 Then
PerfSH.Columns("L") = "."
PerfSH.Columns("I") = "."
PerfSH.Columns("H").UnMerge
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Columns("F").Select
ActiveCell.CurrentRegion.Sort key1:=ActiveCell.CurrentRegion, _
order1:=xlDescending, Header:=xlYes
Sheets.Add
Set A1SH = PerfWB.Sheets("Arkusz1")
ElseIf k > 2 Then
A1SH.Cells(n, 1) = PerfSH.Range("F" & k)
n = n + 1
End If
Else: GoTo line_Next_1
End If
line_Next_1: Next k
Range("A1").Select
Selection.CurrentRegion.Select
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
lastRow = A1SH.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
odd = 2 * i + 1
A1SH.Cells(1, odd - 2) = A1SH.Cells(i, 1)
Next i
For i = 2 To lastRow
A1SH.Cells(i, 1) = ""
Next i
lastColumn = A1SH.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = PerfSH.Cells(Rows.Count, 1).End(xlUp).Row
For k = 0 To lastColumn
odd = k * 2 + 1
n = 1
nextRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
For i = 1 To lastRow
If A1SH.Cells(1, odd) = PerfSH.Range("F" & i) Then
A1SH.Cells(nextRow + n, odd) = PerfSH.Range("O" & i)
n = n + 1
Else: GoTo Line_Next_2
End If
Line_Next_2:
Next i
Next k
For k = 0 To lastColumn
On Error Resume Next
odd = k * 2 + 1
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
ActiveCell.CurrentRegion.Sort key1:=rngCal, order1:=xlDescending, _
Header:=xlYes
Next k
Sheets.Add
Set A2SH = Sheets("Arkusz2")
A1SH.Select
x = 1
nextRow = A2SH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = A2SH.Cells(1, Columns.Count).End(xlToLeft).Column
n = nextRow + 3
For k = 0 To lastColumn
odd = k * 2 + 1
lastRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
If lastRow > 7 Then
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
AvrVal = Application.WorksheetFunction.Average(ActiveCell.CurrentRegion)
For x = 2 To lastRow
If A1SH.Cells(x, odd).Value > (Upper * AvrVal) Or _
A1SH.Cells(x, odd).Value < (Lower * AvrVal) Then
A1SH.Cells(x, odd) = "."
End If
Next x
A1SH.Cells(x, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
A2SH.Cells(n, nextColumn + 2) = A1SH.Cells(1, odd)
A2SH.Cells(n, nextColumn + 3) = Application.WorksheetFunction.Median(rngCal)
A2SH.Cells(n, nextColumn + 4) = Application.WorksheetFunction.Average(rngCal)
n = n + 1
End If
Next k
A2SH.Cells(2, nextColumn + 2) = SkidName
A2SH.Cells(3, nextColumn + 2) = "Formuła"
A2SH.Cells(3, nextColumn + 3) = "Med"
A2SH.Cells(3, nextColumn + 4) = "Avr"
Worksheets("PerformanceReport").Select
lastColumn = Worksheets("PerformanceReport").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastColumn
If Worksheets("PerformanceReport").Cells(1, i) = "" Or Worksheets("PerformanceReport").Cells(1, i) = "." Then
Columns(i).Delete
End If
Next i
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivotka"
Set PivSH = Worksheets("Pivotka")
Set DataSH = Worksheets("PerformanceReport")
lastRow = DataSH.Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = DataSH.Cells(1, Columns.Count).End(xlToLeft).Column
Set PivRange = DataSH.Cells(1, 1).Resize(lastRow, lastColumn)
Set PivCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PivRange).CreatePivotTable _
(TableDestination:=PivSH.Cells(2, 2), TableName:="Pivotka Performance")
Set PivTab = PivCache.CreatePivotTable _
(TableDestination:=PivSH.Cells(1, 1), TableName:="Performance")
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Equipment")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Formula")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Manufacturing Time")
.Orientation = xlDataField
.Position = 1
.Function = xlAverage
.NumberFormat = "#,##0"
.Name = "Manufacturing Time"
End With
'__________________________________________________________________________________________
ElseIf inpSkid = "2" Then
SkidName = "Tetra 4"
Set PerfWB = Workbooks.Open _
("x:\Performance.xls", True, True)
Set PerfSH = PerfWB.Sheets("PerformanceReport")
lastRow = PerfSH.Cells(Rows.Count, "O").End(xlUp).Row
nextRow = OblSH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = OblSH.Cells(2, Columns.Count).End(xlToLeft).Column
n = 1
For k = 2 To lastRow
If PerfSH.Range("E" & k).Text = "TETRA4" Then
If k = 2 Then
PerfSH.Columns("L") = "."
PerfSH.Columns("I") = "."
PerfSH.Columns("H").UnMerge
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Columns("F").Select
ActiveCell.CurrentRegion.Sort key1:=ActiveCell.CurrentRegion, _
order1:=xlDescending, Header:=xlYes
[COLOR=rgb(226, 80, 65)][B]Sheets.Add[/B][/COLOR]
Set A1SH = PerfWB.Sheets("Arkusz1")
ElseIf k > 2 Then
[U] A1SH.Cells(n, 1) = PerfSH.Range("F" & k)[/U]
n = n + 1
End If
Else: GoTo line_Next_3
End If
line_Next_3: Next k
Range("A1").Select
Selection.CurrentRegion.Select
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
lastRow = A1SH.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
odd = 2 * i + 1
A1SH.Cells(1, odd - 2) = A1SH.Cells(i, 1)
Next i
For i = 2 To lastRow
A1SH.Cells(i, 1) = ""
Next i
lastColumn = A1SH.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = PerfSH.Cells(Rows.Count, 1).End(xlUp).Row
For k = 0 To lastColumn
odd = k * 2 + 1
n = 1
nextRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
For i = 1 To lastRow
If A1SH.Cells(1, odd) = PerfSH.Range("F" & i) Then
A1SH.Cells(nextRow + n, odd) = PerfSH.Range("O" & i)
n = n + 1
Else: GoTo Line_Next_4
End If
Line_Next_4:
Next i
Next k
For k = 0 To lastColumn
On Error Resume Next
odd = k * 2 + 1
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
ActiveCell.CurrentRegion.Sort key1:=rngCal, order1:=xlDescending, _
Header:=xlYes
Next k
Sheets.Add
Set A2SH = Sheets("Arkusz2")
A1SH.Select
x = 1
nextRow = A2SH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = A2SH.Cells(1, Columns.Count).End(xlToLeft).Column
n = nextRow + 3
For k = 0 To lastColumn
odd = k * 2 + 1
lastRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
If lastRow > 7 Then
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
AvrVal = Application.WorksheetFunction.Average(ActiveCell.CurrentRegion)
For x = 2 To lastRow
If A1SH.Cells(x, odd).Value > (Upper * AvrVal) Or _
A1SH.Cells(x, odd).Value < (Lower * AvrVal) Then
A1SH.Cells(x, odd) = "."
End If
Next x
A1SH.Cells(x, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
A2SH.Cells(n, nextColumn + 2) = A1SH.Cells(1, odd)
A2SH.Cells(n, nextColumn + 3) = Application.WorksheetFunction.Median(rngCal)
A2SH.Cells(n, nextColumn + 4) = Application.WorksheetFunction.Average(rngCal)
n = n + 1
End If
Next k
A2SH.Cells(2, nextColumn + 2) = SkidName
A2SH.Cells(3, nextColumn + 2) = "Formuła"
A2SH.Cells(3, nextColumn + 3) = "Med"
A2SH.Cells(3, nextColumn + 4) = "Avr"
Worksheets("PerformanceReport").Select
lastColumn = Worksheets("PerformanceReport").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastColumn
If Worksheets("PerformanceReport").Cells(1, i) = "" Or Worksheets("PerformanceReport").Cells(1, i) = "." Then
Columns(i).Delete
End If
Next i
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivotka"
Set PivSH = Worksheets("Pivotka")
Set DataSH = Worksheets("PerformanceReport")
lastRow = DataSH.Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = DataSH.Cells(1, Columns.Count).End(xlToLeft).Column
Set PivRange = DataSH.Cells(1, 1).Resize(lastRow, lastColumn)
Set PivCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PivRange).CreatePivotTable _
(TableDestination:=PivSH.Cells(2, 2), TableName:="Pivotka Performance")
Set PivTab = PivCache.CreatePivotTable _
(TableDestination:=PivSH.Cells(1, 1), TableName:="Performance")
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Equipment")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Formula")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Manufacturing Time")
.Orientation = xlDataField
.Position = 1
.Function = xlAverage
.NumberFormat = "#,##0"
.Name = "Manufacturing Time"
End With
'___________________________________________________________________________________________________________________
ElseIf inpSkid = "3" Then
SkidName = "Tetra 6"
Set PerfWB = Workbooks.Open _
("x:\Performance.xls", True, True)
Set PerfSH = PerfWB.Sheets("PerformanceReport")
lastRow = PerfSH.Cells(Rows.Count, "O").End(xlUp).Row
nextRow = OblSH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = OblSH.Cells(2, Columns.Count).End(xlToLeft).Column
n = 1
For k = 2 To lastRow
If PerfSH.Range("E" & k).Text = "TETRA6" Then
If k = 2 Then
PerfSH.Columns("L") = "."
PerfSH.Columns("I") = "."
PerfSH.Columns("H").UnMerge
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Rows(lastRow + 3).Delete
PerfSH.Columns("F").Select
ActiveCell.CurrentRegion.Sort key1:=ActiveCell.CurrentRegion, _
order1:=xlDescending, Header:=xlYes
[COLOR=rgb(226, 80, 65)][B] Sheets.Add[/B][/COLOR]
Set A1SH = PerfWB.Sheets("Arkusz1")
ElseIf k > 2 Then
[U]A1SH.Cells(n, 1) = PerfSH.Range("F" & k)[/U]
n = n + 1
End If
Else: GoTo line_Next_5
End If
line_Next_5: Next k
Range("A1").Select
Selection.CurrentRegion.Select
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
lastRow = A1SH.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
odd = 2 * i + 1
A1SH.Cells(1, odd - 2) = A1SH.Cells(i, 1)
Next i
For i = 2 To lastRow
A1SH.Cells(i, 1) = ""
Next i
lastColumn = A1SH.Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = PerfSH.Cells(Rows.Count, 1).End(xlUp).Row
For k = 0 To lastColumn
odd = k * 2 + 1
n = 1
nextRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
For i = 1 To lastRow
If A1SH.Cells(1, odd) = PerfSH.Range("F" & i) Then
A1SH.Cells(nextRow + n, odd) = PerfSH.Range("O" & i)
n = n + 1
Else: GoTo Line_Next_6
End If
Line_Next_6:
Next i
Next k
For k = 0 To lastColumn
On Error Resume Next
odd = k * 2 + 1
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
ActiveCell.CurrentRegion.Sort key1:=rngCal, order1:=xlDescending, _
Header:=xlYes
Next k
Sheets.Add
Set A2SH = Sheets("Arkusz2")
A1SH.Select
x = 1
nextRow = A2SH.Cells(Rows.Count, 1).End(xlUp).Row
nextColumn = A2SH.Cells(1, Columns.Count).End(xlToLeft).Column
n = nextRow + 3
For k = 0 To lastColumn
odd = k * 2 + 1
lastRow = A1SH.Cells(Rows.Count, odd).End(xlUp).Row
If lastRow > 7 Then
A1SH.Cells(1, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
AvrVal = Application.WorksheetFunction.Average(ActiveCell.CurrentRegion)
For x = 2 To lastRow
If A1SH.Cells(x, odd).Value > (Upper * AvrVal) Or _
A1SH.Cells(x, odd).Value < (Lower * AvrVal) Then
A1SH.Cells(x, odd) = "."
End If
Next x
A1SH.Cells(x, odd).Select
Selection.CurrentRegion.Select
Set rngCal = ActiveCell.CurrentRegion
A2SH.Cells(n, nextColumn + 2) = A1SH.Cells(1, odd)
A2SH.Cells(n, nextColumn + 3) = Application.WorksheetFunction.Median(rngCal)
A2SH.Cells(n, nextColumn + 4) = Application.WorksheetFunction.Average(rngCal)
n = n + 1
End If
Next k
A2SH.Cells(2, nextColumn + 2) = SkidName
A2SH.Cells(3, nextColumn + 2) = "Formuła"
A2SH.Cells(3, nextColumn + 3) = "Med"
A2SH.Cells(3, nextColumn + 4) = "Avr"
Worksheets("PerformanceReport").Select
lastColumn = Worksheets("PerformanceReport").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastColumn
If Worksheets("PerformanceReport").Cells(1, i) = "" Or Worksheets("PerformanceReport").Cells(1, i) = "." Then
Columns(i).Delete
End If
Next i
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivotka"
Set PivSH = Worksheets("Pivotka")
Set DataSH = Worksheets("PerformanceReport")
lastRow = DataSH.Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = DataSH.Cells(1, Columns.Count).End(xlToLeft).Column
Set PivRange = DataSH.Cells(1, 1).Resize(lastRow, lastColumn)
Set PivCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PivRange).CreatePivotTable _
(TableDestination:=PivSH.Cells(2, 2), TableName:="Pivotka Performance")
Set PivTab = PivCache.CreatePivotTable _
(TableDestination:=PivSH.Cells(1, 1), TableName:="Performance")
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Equipment")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Formula")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Pivotka Performance").PivotFields("Manufacturing Time")
.Orientation = xlDataField
.Position = 1
.Function = xlAverage
.NumberFormat = "#,##0"
.Name = "Manufacturing Time"
End With
ElseIf inpSkid = "4" Then
Set PerfWB = Workbooks.Open _
("x:\Performance.xls", True, True)
Set PerfSH = PerfWB.Sheets("PerformanceReport")
End If
Sheets("Arkusz2").Select
MsgBox "Koniec"
End Sub