Ismael
New Member
- Joined
- Apr 21, 2021
- Messages
- 1
- Office Version
- 2019
- Platform
- Windows
VBA Code:
Sub REPORT_BH()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Information").Activate
Dim i As Integer, Nr As Integer, c As Integer
Dim lastRow As Long
lastRow = WorksheetFunction.CountA(Sheets("Information").Range("A:A"))
Nr = Range("TBL").Rows.Count
For i = 1 To Nr
If UserForm1.ComboBox1 = Range("TBL").Cells(i, 5) _
And UserForm1.ComboBox2 = Range("TBL").Cells(i, 6) _
And UserForm1.ComboBox3 = Range("TBL").Cells(i, 7) _
And UserForm1.ComboBox4 = Range("TBL").Cells(i, 8) _
And UserForm1.ComboBox5 = Range("TBL").Cells(i, 9) _
And UserForm1.ComboBox6 = Range("TBL").Cells(i, 10) _
And UserForm1.ComboBox7 = Range("TBL").Cells(i, 11) Then
c = c + 1
MsgBox c
If c <= 12 Then
'rig
Range("A2:AF15562").Range("L" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:B34").Range("A" & c).PasteSpecial xlPasteValues
'start depth
Sheets("Information").Select
Range("A2:AF15562").Range("N" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:D34").Range("B" & c).PasteSpecial xlPasteValues
Range("B23:D34").Range("B" & c & ":" & "C" & c).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
' end depth
Sheets("Information").Select
Range("A2:AF15562").Range("p" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:F34").Range("D" & c).PasteSpecial xlPasteValues
Range("B23:F34").Range("D" & c & ":" & "E" & c).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
'shfit
Sheets("Information").Select
Range("A2:AF15562").Range("D" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("A23:A34").Range("A" & c).PasteSpecial xlPasteAll
' data
Sheets("Information").Select
Range("A2:AF15562").Range("B" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:G34").Range("F" & c).PasteSpecial xlPasteAll
Dim olddate As Date, newdate As Date
olddate = DateValue(Range("B23:G34").Range("F" & c))
If Range("A23:A34").Range("A" & c) = "Night" Then
newdate = olddate + 1
Range("B23:G34").Range("F" & c) = newdate
End If
' Time 1
Sheets("Information").Select
Range("A2:AF15562").Range("O" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:H34").Range("G" & c).PasteSpecial xlPasteAll
Range("B23:H34").Range("G" & c).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Time 2
Sheets("Information").Select
Range("A2:AF15562").Range("Q" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:I34").Range("H" & c).PasteSpecial xlPasteAll
Range("B23:I34").Range("H" & c).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Type Drilling
Sheets("Information").Select
Range("A2:AF15562").Range("R" & i).Copy
Sheets("Borehole_Report_page1").Select
Range("B23:AA34").Range("Z" & c).PasteSpecial xlPasteValues
Range("B23:AT34").Range("Z" & c & ":" & "AS" & c).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Sheets("Information").Select
ElseIf c > 12 And c < 25 Then
'rig
Range("A3:AF15562").Range("L" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:B34").Range("A" & c - 12).PasteSpecial xlPasteValues
'start depth
Sheets("Information").Select
Range("A3:AF15562").Range("N" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:D34").Range("B" & c - 12).PasteSpecial xlPasteValues
Range("B23:D34").Range("B" & c - 12 & ":" & "C" & c - 12).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
' end depth
Sheets("Information").Select
Range("A3:AF15562").Range("P" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:F34").Range("D" & c - 12).PasteSpecial xlPasteValues
Range("B23:F34").Range("D" & c - 12 & ":" & "E" & c - 12).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
'shfit
Sheets("Information").Select
Range("A3:AF15562").Range("D" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("A23:A34").Range("A" & c - 12).PasteSpecial xlPasteAll
' data
Sheets("Information").Select
Range("A3:AF15562").Range("B" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:G34").Range("F" & c - 12).PasteSpecial xlPasteAll
olddate = DateValue(Range("B23:G34").Range("F" & c - 12))
If Range("A23:A34").Range("A" & c - 12) = "N" Then
newdate = olddate + 1
Range("B23:G34").Range("F" & c - 12) = newdate
End If
' Time 1
Sheets("Information").Select
Range("A3:AF15562").Range("O" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:H34").Range("G" & c - 12).PasteSpecial xlPasteAll
Range("B23:H34").Range("G" & c - 12).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Time 2
Sheets("Information").Select
Range("A3:AF15562").Range("Q" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:I34").Range("H" & c - 12).PasteSpecial xlPasteAll
Range("B23:I34").Range("H" & c - 12).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Type Drilling
Sheets("Information").Select
Range("A3:AF15562").Range("R" & i).Copy
Sheets("Borehole_Report_page2").Select
Range("B23:AA34").Range("Z" & c - 12).PasteSpecial xlPasteValues
Range("B23:AT34").Range("Z" & c - 12 & ":" & "AS" & c - 12).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Sheets("Information").Select
ElseIf c > 24 Then
'rig
Range("A3:AF15562").Range("L" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:B34").Range("A" & c - 24).PasteSpecial xlPasteValues
'start depth
Sheets("Information").Select
Range("A3:AF15562").Range("N" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:D34").Range("B" & c - 24).PasteSpecial xlPasteValues
Range("B23:D34").Range("B" & c - 24 & ":" & "C" & c - 24).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
' end depth
Sheets("Information").Select
Range("A3:AF15562").Range("P" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:F34").Range("D" & c - 24).PasteSpecial xlPasteValues
Range("B23:F34").Range("D" & c - 24 & ":" & "E" & c - 24).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
'shfit
Sheets("Information").Select
Range("A3:AF15562").Range("D" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("A23:A34").Range("A" & c - 24).PasteSpecial xlPasteAll
' data
Sheets("Information").Select
Range("A3:AF15562").Range("B" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:G34").Range("F" & c - 24).PasteSpecial xlPasteAll
olddate = DateValue(Range("B23:G34").Range("F" & c - 24))
If Range("A23:A34").Range("A" & c - 24) = "N" Then
newdate = olddate + 1
Range("B23:G34").Range("F" & c - 24) = newdate
End If
' Time 1
Sheets("Information").Select
Range("A3:AF15562").Range("O" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:H34").Range("G" & c - 24).PasteSpecial xlPasteAll
Range("B23:H34").Range("G" & c - 24).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Time 2
Sheets("Information").Select
Range("A3:AF15562").Range("Q" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:I34").Range("H" & c - 24).PasteSpecial xlPasteAll
Range("B23:I34").Range("H" & c - 24).Select
With Selection
HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Type Drilling
Sheets("Information").Select
Range("A3:AF15562").Range("R" & i).Copy
Sheets("Borehole_Report_page3").Select
Range("B23:AA34").Range("Z" & c - 24).PasteSpecial xlPasteValues
Range("B23:AT34").Range("Z" & c - 24 & ":" & "AS" & c - 24).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Sheets("Information").Select
End If
End If
Next i
End Sub
Last edited by a moderator: