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
Bookmarks