B
Benjamin
My end goal is to create multi-line code that I can paste into VBE.
Currently I'm pasting code like this...
If Worksheets("vessel").Cells(CurVesl,8).Value Then
Else
frmVesselLog.DTPICKER1.value = Worksheets("vessel").Cells(CurVesl,11).Value
End IF
For example Column D is:If Worksheets("vessel").Cells(CurVesl,8).Value Then
Column E is : Else
Column F is: frmVesselLog.DTPICKER1.value =
Worksheets("vessel").Cells(CurVesl,11).Value
Column G: End IF
Column H is
row1 If Worksheets("vessel").Cells(CurVesl,8).Value Then
row2 Else
row 3 frmVesselLog.DTPICKER1.value =
Worksheets("vessel").Cells(CurVesl,11).Value
row 4 End IF
IS there a better way/faster way, maybe highlight all the column I want to
create into a multiline code to paste?
I'd appreciate any help to 1-make this a simple process, as sometime I have
3 columns, sometimes 4, sometimes 6, just depends.
Code below:
Sub Create_MultiLine_Code()
Dim DestRow As Integer
Dim Row As Integer
Dim strA As String
Dim strB As String
Dim strC As String
Dim strD As String
Dim ColStrA As Integer
Dim ColStrB As Integer
Dim ColStrC As Integer
Dim ColStrDest As Integer
Dim DestCol As Integer
Const strConst As String = "End Sub" 'Last Line of Text
Row = 1 'Place to Start
DestRow = Row 'Row to Start
DestCol = 8 'Place for Text to end up in
ActiveSheet.Cells(1, DestCol).Activate
Select Case MsgBox("WIll Overwrite all Data in Column #" & DestCol _
& vbCrLf & "Are You Sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "")
Case vbYes
GoTo EndSelect2
Case vbNo
Exit Sub
End Select
EndSelect2:
Do Until IsEmpty(Cells(Row, 1))
strA = ThisWorkbook.ActiveSheet.Cells(Row, 3).Value 'First Line of Text d
strB = ThisWorkbook.ActiveSheet.Cells(Row, 6).Value 'Second Line of Text j
strC = ThisWorkbook.ActiveSheet.Cells(Row, 7).Value 'Third Line of Text k
' strD = ThisWorkbook.ActiveSheet.Cells(Row, 6).Value 'Third Line of Text f
ThisWorkbook.ActiveSheet.Cells(DestRow, DestCol).Value = strA
ThisWorkbook.ActiveSheet.Cells(DestRow + 1, DestCol).Value = strB
ThisWorkbook.ActiveSheet.Cells(DestRow + 2, DestCol).Value = strC
' ThisWorkbook.ActiveSheet.Cells(DestRow + 3, DestCol).Value = strD
DestRow = DestRow + 3 'I change this depending on the code
Row = Row + 1
Loop
End Sub
Currently I'm pasting code like this...
If Worksheets("vessel").Cells(CurVesl,8).Value Then
Else
frmVesselLog.DTPICKER1.value = Worksheets("vessel").Cells(CurVesl,11).Value
End IF
For example Column D is:If Worksheets("vessel").Cells(CurVesl,8).Value Then
Column E is : Else
Column F is: frmVesselLog.DTPICKER1.value =
Worksheets("vessel").Cells(CurVesl,11).Value
Column G: End IF
Column H is
row1 If Worksheets("vessel").Cells(CurVesl,8).Value Then
row2 Else
row 3 frmVesselLog.DTPICKER1.value =
Worksheets("vessel").Cells(CurVesl,11).Value
row 4 End IF
IS there a better way/faster way, maybe highlight all the column I want to
create into a multiline code to paste?
I'd appreciate any help to 1-make this a simple process, as sometime I have
3 columns, sometimes 4, sometimes 6, just depends.
Code below:
Sub Create_MultiLine_Code()
Dim DestRow As Integer
Dim Row As Integer
Dim strA As String
Dim strB As String
Dim strC As String
Dim strD As String
Dim ColStrA As Integer
Dim ColStrB As Integer
Dim ColStrC As Integer
Dim ColStrDest As Integer
Dim DestCol As Integer
Const strConst As String = "End Sub" 'Last Line of Text
Row = 1 'Place to Start
DestRow = Row 'Row to Start
DestCol = 8 'Place for Text to end up in
ActiveSheet.Cells(1, DestCol).Activate
Select Case MsgBox("WIll Overwrite all Data in Column #" & DestCol _
& vbCrLf & "Are You Sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "")
Case vbYes
GoTo EndSelect2
Case vbNo
Exit Sub
End Select
EndSelect2:
Do Until IsEmpty(Cells(Row, 1))
strA = ThisWorkbook.ActiveSheet.Cells(Row, 3).Value 'First Line of Text d
strB = ThisWorkbook.ActiveSheet.Cells(Row, 6).Value 'Second Line of Text j
strC = ThisWorkbook.ActiveSheet.Cells(Row, 7).Value 'Third Line of Text k
' strD = ThisWorkbook.ActiveSheet.Cells(Row, 6).Value 'Third Line of Text f
ThisWorkbook.ActiveSheet.Cells(DestRow, DestCol).Value = strA
ThisWorkbook.ActiveSheet.Cells(DestRow + 1, DestCol).Value = strB
ThisWorkbook.ActiveSheet.Cells(DestRow + 2, DestCol).Value = strC
' ThisWorkbook.ActiveSheet.Cells(DestRow + 3, DestCol).Value = strD
DestRow = DestRow + 3 'I change this depending on the code
Row = Row + 1
Loop
End Sub