+ Reply to Thread
Results 1 to 2 of 2

VBA Paste Macro

Hybrid View

jimdare VBA Paste Macro 01-28-2011, 05:11 AM
pike Re: VBA Paste Macro 01-28-2011, 05:49 AM
  1. #1
    Registered User
    Join Date
    07-29-2007
    Posts
    24

    VBA Paste Macro

    Hello,

    I have been asked to modify a macro that one of my collegues wrote a while ago. Basically It takes a clump of text from the clipboard and pastes it into certain categorical columns, in the next available row of the worksheet. It is currently set up so it pastes into the first sheet of the workbook, however I need it to paste into the second. Could anyone please take a look at the code below and let me know what parts of the code I need to alter to do this.

    My current worrkbook is comprised of two sheets:

    Sheet 1 = "Main sheet"
    Sheet 2 = "Inside Sales"

    Your help is much appreciated.

    Regards,
    Jimdare

    Code:

    Private Sub cmdPasteNewRow_Click()
    Dim strClipboardData As String
    Dim varRows As Variant
    Dim varCols As Variant
    Dim varLooper As Variant
    Dim DataObj As New MSForms.DataObject
    Dim strField As String
    Dim strValue As String
    Dim intRow As Integer
    Dim strCol As String
    Dim objCurrNVP As cNameValuePair
    DataObj.GetFromClipboard
    strClipboardData = DataObj.GetText
    intRow = fncFirstEmptyRow

    varRows = fncSplitPaste(strClipboardData)

    For Each varLooper In varRows
    If Not IsEmpty(varLooper) Then
    If varLooper.Value = "" Then

    Else
    strCol = ""
    Select Case LCase(varLooper.Name)
    Case "skypename"
    strCol = "R"
    Case "last name"
    strCol = "W"
    Case "first name"
    strCol = "V"
    Case "job title"
    strCol = "X"
    Case "email address"
    strCol = "U"
    Case "phone number"
    strCol = "T"
    Case "company name"
    strCol = "Q"
    Case "country"
    strCol = "S"
    Case "monthly spend"
    strCol = "Y"
    End Select
    If strCol <> "" Then
    Sheet1.Range(strCol & intRow).Value = varLooper.Value
    End If
    End If
    End If
    Next
    Sheet1.Range("A" & intRow).Value = Date
    End Sub

    Function fncFirstEmptyRow() As Integer
    Dim exrStart As Excel.Range
    Dim exrEnd As Excel.Range
    Set exrStart = Sheet1.Range("A1")
    Set exrEnd = exrStart.End(xlDown)
    fncFirstEmptyRow = exrEnd.Row + 1
    End Function

    Function fncSplitPaste(strToSplit As String) As Variant
    Dim intRowCounter As Integer
    Dim varRows(20) As Variant
    Dim strBefore As String
    Dim strAfter As String
    Dim strCurrChar As String
    Dim intPairCount As Integer
    Dim intCharCounter As Integer
    Dim intNextPos As Integer
    Dim intNextColon As Integer
    Dim objNVPair As cNameValuePair
    Dim varSplitRows As Variant
    Dim varSplitCols As Variant
    Dim strCurrRow As String
    Dim varLooper As Variant
    varSplitRows = Split(strToSplit, vbCrLf)
    For Each varLooper In varSplitRows
    strCurrRow = Trim(varLooper)
    varSplitCols = Split(strCurrRow, ": ")
    If UBound(varSplitCols) > 0 Then
    Set objNVPair = New cNameValuePair
    objNVPair.Name = varSplitCols(0)
    objNVPair.Value = varSplitCols(1)
    Set varRows(intPairCount) = objNVPair
    intPairCount = intPairCount + 1
    End If
    Next
    fncSplitPaste = varRows
    Exit Function

    For intCharCounter = 1 To Len(strToSplit)
    strCurrChar = Mid(strToSplit, intCharCounter, 1)
    If strCurrChar = ":" Then '
    Set objNVPair = New cNameValuePair
    objNVPair.Name = Trim(strBefore)
    intNextPos = InStr(1, Mid(strToSplit, intCharCounter + 3), vbCrLf)
    intNextColon = InStr(1, Mid(strToSplit, intCharCounter + 3), ":")
    If intNextPos - 1 = intNextColon Then
    intCharCounter = intCharCounter + 3
    Else
    If intNextPos = 0 Then
    objNVPair.Value = Mid(strToSplit, intCharCounter + 3)
    intCharCounter = Len(strToSplit)
    Else
    objNVPair.Value = Mid(strToSplit, intCharCounter + 3, intNextPos - 1)
    intCharCounter = intCharCounter + intNextPos + 3
    End If
    End If
    strBefore = ""
    Set varRows(intPairCount) = objNVPair
    intPairCount = intPairCount + 1
    Else
    strBefore = strBefore & strCurrChar
    End If
    Next
    fncSplitPaste = varRows
    End Function

  2. #2
    Forum Expert pike's Avatar
    Join Date
    12-11-2005
    Location
    Alstonville, Australia
    MS-Off Ver
    2016
    Posts
    5,342

    Re: VBA Paste Macro

    Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here
    If the solution helped please donate to RSPCA

    Site worth visiting: Rabbitohs

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1