VBA twist

abshaw

Board Regular
Joined
Feb 12, 2004
Messages
53
I got TommyGun(MrExcel MVP) to help me do the following code

Sub DumpSalesInfo()
Dim SalesPeople As New Collection
Dim Sales As New Collection

Dim SHEET_1 As Worksheet
Dim SHEET_2 As Worksheet

Dim SHEET_1_lastRow As Long
Dim SHEET_2_lastRow As Long

Dim csvDump As String

Dim errCount As Long
Dim i As Long, f As Long

Const DUMPFILE As String = "C:\Temp\dump.csv"

Set SHEET_1 = ActiveWorkbook.Sheets("Sheet1") 'change to your sheet1
Set SHEET_2 = ActiveWorkbook.Sheets("Sheet2") 'change to your sheet2

SHEET_1_lastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
SHEET_2_lastRow = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row

For i = 1 To SHEET_1_lastRow
With SHEET_1
On Error Resume Next
SalesPeople.Add Item:=Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
key:=CStr(.Cells(i, 1))
If Err.Number <> 0 Then
MsgBox "Salesperson ID: " & .Cells(i, 1) & vbNewLine & vbNewLine & _
"This ID already exists in the collection.", vbOKOnly + vbInformation, "Error"
errCount = errCount + 1
End If
On Error GoTo 0
End With
Next

For i = 1 To SHEET_2_lastRow
With SHEET_2
On Error Resume Next
Sales.Add Item:=Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
key:=CStr(.Cells(i, 1))
If Err.Number <> 0 Then
Dim tmp As String

tmp = Sales(CStr(.Cells(i, 1)))

Sales.Remove CStr(.Cells(i, 1))

Sales.Add Item:=tmp & "," & Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
key:=CStr(.Cells(i, 1))
End If
On Error GoTo 0
End With
Next

csvDump = SalesPeople(1) & "," & Sales(Mid(SalesPeople(1), 2, 4))

For i = 2 To SalesPeople.Count
On Error Resume Next
csvDump = csvDump & vbNewLine & _
SalesPeople(i) & "," & Sales(Mid(SalesPeople(i), 2, 4))
If Err.Number <> 0 Then
csvDump = csvDump & vbNewLine & SalesPeople(i)
End If
On Error GoTo 0
Next

f = FreeFile

Open DUMPFILE For Output As #f
Print #f, csvDump
Close #f

MsgBox "Process Complete!" & vbNewLine & vbNewLine & _
"Errors: " & errCount, vbOKOnly + vbInformation, "CSV Dump"

Set SalesPeople = Nothing
Set Sales = Nothing

Set SHEET_1 = Nothing
Set SHEET_2 = Nothing
End Sub

Private Function Range2CSV(value As Range) As String
Dim tmp As String
Dim c As Range

For Each c In value.Cells
tmp = tmp & ",""" & c.value & """"
Next

Range2CSV = Mid(tmp, 2, Len(tmp) - 1)
End Function

this code is supposed to do the following (which it does it in a good manner)



I am doing an export as comma separated values file out of excel. i did manage to create the a csv file with all the sales people at the end of each day. there are two 3 sheets that i have as follows


Sheet 1

column a --> Salesperson ID
column b --> First name
column c --> Last name
column d --> effective date
column e --> term date

column a b c are text type data fields
column d e are date type data fields.


Sheet 2

column a --> Salesperson ID
column b --> Invoice no
column c --> Product name
column d --> amount

column a b c are text type data fields
column d is currency type data field.


Sheet 3

is currently blank and i am not using it.

(the column headers are not there in the actual sheet, but to explain, i gave them sample names, the actual sheet only has the data in it)

now lets say the first three lines of data are as follows

Sheet 1
6587 jake lumas 01/02/2004 05/02/2004
0543 mary edgar 01/02/2004
3545 james lomaki 01/02/2004 03/05/2004

Sheet 2
6587 td12548 facial cream 19.95
3545 td32548 massager 69.99
6587 td26584 foot cream 20.22


What i want is to create a single record for each person in the csv file by the name of dump in C:/temp folder so the full path will be C:/temp/dump.csv
what the final text file should look like is

line 1

"6587","jake","lumas","01/02/2004","05/02/2004","6587","td12548","facial cream","19.95","6587","td26584","foot cream","20.22"

line 2
"0543","mary edgar","01/02/2004",""

line 3
"3545","james","lomaki","01/02/2004","03/05/2004","3545","td32548","massager","69.99 "







but the twist is that my agent id is in the third column instead of the first. Please help.
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Okay, I adjusted this to pull the Agent ID from the third column. Question though, did that also adjust the rest of your ranges, or just the layout?

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> DumpSalesInfo()
    <SPAN style="color:#00007F">Dim</SPAN> SalesPeople <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">New</SPAN> Collection
    <SPAN style="color:#00007F">Dim</SPAN> Sales <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">New</SPAN> Collection
    
    <SPAN style="color:#00007F">Dim</SPAN> SHEET_1 <SPAN style="color:#00007F">As</SPAN> Worksheet
    <SPAN style="color:#00007F">Dim</SPAN> SHEET_2 <SPAN style="color:#00007F">As</SPAN> Worksheet
    
    <SPAN style="color:#00007F">Dim</SPAN> SHEET_1_lastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> SHEET_2_lastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#00007F">Dim</SPAN> csvDump <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    
    <SPAN style="color:#00007F">Dim</SPAN> errCount <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, f <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    <SPAN style="color:#00007F">Const</SPAN> DUMPFILE <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "C:\Temp\dump.csv"
    
    <SPAN style="color:#00007F">Set</SPAN> SHEET_1 = ActiveWorkbook.Sheets("Sheet1") <SPAN style="color:#007F00">'change to your sheet1</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> SHEET_2 = ActiveWorkbook.Sheets("Sheet2") <SPAN style="color:#007F00">'change to your sheet2</SPAN>
    
    SHEET_1_lastRow = Sheet1.Cells(Sheet1.Rows.Count, 3).End(xlUp).Row
    SHEET_2_lastRow = Sheet2.Cells(Sheet2.Rows.Count, 3).End(xlUp).Row
    
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> SHEET_1_lastRow
        <SPAN style="color:#00007F">With</SPAN> SHEET_1
            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
            SalesPeople.Add Item:=Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
                key:=CStr(.Cells(i, 3))
            <SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN>
                MsgBox "Salesperson ID: " & .Cells(i, 3) & vbNewLine & vbNewLine & _
                    "Already exists in this collection.", vbOKOnly + vbInformation, "Error"
                errCount = errCount + 1
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    <SPAN style="color:#00007F">Next</SPAN>
    
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> SHEET_2_lastRow
        <SPAN style="color:#00007F">With</SPAN> SHEET_2
            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
            Sales.Add Item:=Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
                key:=CStr(.Cells(i, 3))
            <SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN>
                <SPAN style="color:#00007F">Dim</SPAN> tmp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
                
                tmp = Sales(CStr(.Cells(i, 3)))
                
                Sales.Remove <SPAN style="color:#00007F">CStr</SPAN>(.Cells(i, 3))
                
                Sales.Add Item:=tmp & "," & Range2CSV(.Range(.Cells(i, 1), .Cells(i, 4))), _
                    key:=CStr(.Cells(i, 3))
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    <SPAN style="color:#00007F">Next</SPAN>
                
    csvDump = SalesPeople(1) & "," & Sales(Mid(SalesPeople(1), 2, 4))
                
    <SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> SalesPeople.Count
        <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
        csvDump = csvDump & vbNewLine & _
            SalesPeople(i) & "," & Sales(Mid(SalesPeople(i), 2, 4))
        <SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN>
            csvDump = csvDump & vbNewLine & SalesPeople(i)
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0
    <SPAN style="color:#00007F">Next</SPAN>
    
    f = FreeFile
    
    <SPAN style="color:#00007F">Open</SPAN> DUMPFILE <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Output</SPAN> <SPAN style="color:#00007F">As</SPAN> #f
        <SPAN style="color:#00007F">Print</SPAN> #f, csvDump
    <SPAN style="color:#00007F">Close</SPAN> #f

    MsgBox "Process Complete!" & vbNewLine & vbNewLine & _
        "Errors: " & errCount, vbOKOnly + vbInformation, "CSV Dump"

    <SPAN style="color:#00007F">Set</SPAN> SalesPeople = <SPAN style="color:#00007F">Nothing</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> Sales = <SPAN style="color:#00007F">Nothing</SPAN>
    
    <SPAN style="color:#00007F">Set</SPAN> SHEET_1 = <SPAN style="color:#00007F">Nothing</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> SHEET_2 = <SPAN style="color:#00007F">Nothing</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0
i tried the code it give me the following error

Complie error:
Sub or Function not defined

at the following line

SalesPeople.Add Item:=Range2CSV(.Range(.Cells(i, 1), .Cells(i, 19))), _
key:=CStr(.Cells(i, 3))
and it highlights "Range2CSV"

:confused:
 
Upvote 0
You do still have the Range2CSV function that I provided earlier in your code correct?
 
Upvote 0
i am sorry , please disregard the Range2CSV error, i fixed it right away

but now i get the following error,

Run-time error "5":
Invalid procedure call or argument

on this line

csvDump = SalesPeople(1) & "," & Sales(Mid(SalesPeople(1), 2, 4))
 
Upvote 0
yes, thankyou, i have that Range2CSV function and have used it to pass the first error. :biggrin:
 
Upvote 0

Forum statistics

Threads
1,215,165
Messages
6,123,387
Members
449,098
Latest member
ArturS75

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top