MultiLine Code Builder, Need Help to Clean Code:

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top