Consulting

Results 1 to 2 of 2

Thread: Copy cells in col. B, D and F if there is contents in cells in col. D

  1. #1

    Copy cells in col. B, D and F if there is contents in cells in col. D

    I am a "novice" in the field of vba and need assistance with code for the following task.
    Thank you in advance for any valuable replies.

    I have already made the code below and it works as I expect. It copies all cells in three columns, concatenates with various word strings, copies that and places the result in the clipboard.
    A msg box appears in order to not clear the contents of the clipboard.
    I then paste the contents of the clipboard into a word document. Which then pulls autotext/building blocks based on the pasted text string, in fact only the part that is derived from col. B

    However I have changed other procedures in this WB which serves for a better experience with the autotext in word.

    TASK
    I need to only copy cells of col. A, D and F if there is contents in col. D - please refer to the attached image for visual reference.
    The concatenation procedure shall remain as is.



    Exisitng code that is attached to the button "Copy item no."

    Sub CopyPosItemNumber()


    Application.ScreenUpdating = False


    'Unhide sheet
    Sheets("Concat").Visible = True


    'Unprotects sheet


    Sheets("Commercial Calculation").Select
    Sheets("Commercial Calculation").Unprotect Password:=3095
    Sheets("Concat").Select
    Sheets("Concat").Unprotect Password:=3095




    Sheets("Concat").Range("A:F").ClearContents






    'copies amount pieces number and paste to column B
    Sheets("Commercial Calculation").Select
    ActiveSheet.Range("F11", ActiveSheet.Range("F11").End(xlDown)).Select
    Selection.Copy
    Sheets("Concat").Range("B1").PasteSpecial Paste:=xlPasteValues


    'copies item number and paste to column C
    Sheets("Commercial Calculation").Select
    ActiveSheet.Range("B11", ActiveSheet.Range("B11").End(xlDown)).Select
    Selection.Copy
    Sheets("Concat").Range("C1").PasteSpecial Paste:=xlPasteValues


    'copies position number and paste to column A IMPORTANT because this is the last pasted objects this column
    'is selected and that is why it is possible to insert Pos to these values you could also just selcte that column before
    'starting the Pos paste runtime
    Sheets("Commercial Calculation").Select
    ActiveSheet.Range("D11", ActiveSheet.Range("D11").End(xlDown)).Select
    Selection.Copy
    Sheets("Concat").Range("A1").PasteSpecial Paste:=xlPasteValues




    Sheets("Concat").Select


    Dim IngLastRow As Long
    'Uses Column A to set the IngLastRow variable (find last row) change if required.
    IngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


    'Inserts Pos before contents of A
    Dim a As Range
    For Each a In Selection
    If a.Value <> "" Then a.Value = "Pos " & a.Value
    Next


    'Concatenates B amount and C item no and inserts a blank space, a dash and a blank space after Pos places result in colum D
    Range("D1" & IngLastRow).Formula = "=B1 & "" "" & C1"


    'Concatenate A pos no and D amount and item and inserts a blank space, a dash and a blank space after Pos places result in colum D
    Range("E1:E" & IngLastRow).Formula = "=A1 & "" - "" & D1"




    Dim i As Long
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim str As String
    str = ""
    Set sht = Sheets("Concat")
    LastRow = sht.Cells(sht.Rows.Count, "E").End(xlUp).Row


    'takes all rows i column E and places that in cell F1 with carriage return i is the string which is the text in cells C
    For i = 1 To LastRow
    str = str + Cells(i, 5).Value & vbCrLf
    Next i
    Sheets("Concat").Range("F1").Value = str


    'Copies contents of cell D1 to clipboard
    Sheets("Concat").Select
    ActiveSheet.Range("F1").Copy


    Sheets("Commercial Calculation").Select


    MsgBox "Please DO NOT close this message" & vbNewLine & "Before you have pasted contents to Word", vbOKOnly + vbInformation, "Paste to Word"


    Sheets("Commercial Calculation").Protect Password:=3095


    'Hide sheet
    Sheets("Concat").Visible = False


    Application.ScreenUpdating = True




    End Sub

  2. #2
    Trying to post the picture
    Attached Images Attached Images

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •