Link to home
Start Free TrialLog in
Avatar of Euro5
Euro5Flag for United States of America

asked on

Use closed file on desktop in vba

In this code, cws is a cvs file on the desktop C:\user\12345\desktop\surcharge data

Can anyone help me modify the code to change it from a workbook sheet to the external file?

Sub CombineShipmentCharges()
Dim sws As Worksheet, cws As Worksheet
Dim x, y, z, dict
Dim i As Long, j As Long, slr As Long, clr As Long, slc As Long
Dim str
Set sws = Sheets("Shipments")
Set cws = Sheets("Charges")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
clr = cws.Cells(Rows.Count, 1).End(xlUp).Row
slc = sws.Cells(1, Columns.Count).End(xlToLeft).Column
If slr < 2 Or clr < 2 Then
   MsgBox "Data not found!", vbCritical
   Exit Sub
End If
If slc > 10 Then sws.Range("K1", sws.Cells(slr, slc)).Clear
Set dict = CreateObject("Scripting.Dictionary")
x = sws.Range("A2:A" & slr).Value
y = cws.Range("A1").CurrentRegion.Value

For i = 1 To UBound(x, 1)
   dict.Item(x(i, 1)) = ""
Next i

For i = 2 To UBound(y, 1)
   If dict.Item(y(i, 1)) = "" Then
      dict.Item(y(i, 1)) = y(i, 10) & ";" & y(i, 11)
   Else
      dict.Item(y(i, 1)) = dict.Item(y(i, 1)) & ";" & y(i, 10) & ";" & y(i, 11)
   End If
Next i

For i = 1 To UBound(x, 1)
   z = Split(dict.Item(x(i, 1)), ";")
   sws.Range("K" & i + 1).Resize(1, UBound(z, 1) + 1).Value = z
Next i

slc = sws.UsedRange.Columns.Count
sws.Range("A" & slr + 1).Copy
sws.Range("K2", sws.Cells(slr, slc)).PasteSpecial operation:=xlAdd
sws.Range("K2", sws.Cells(slr, slc)).NumberFormat = "#0.00"
sws.Range("K1:L1").Value = Array("Surcharge desc 1", "Surcharge Amount 1")
sws.Range("K1:L1").AutoFill sws.Range("K1", sws.Cells(1, slc)), xlFillDefault
sws.Columns.AutoFit
Set dict = Nothing
End Sub

Open in new window

Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

See if that works....

Sub CombineShipmentCharges()
Dim wb As Workbook
Dim sws As Worksheet, cws As Worksheet
Dim x, y, z, dict
Dim i As Long, j As Long, slr As Long, clr As Long, slc As Long, nslc As Long
Dim str
Set sws = Sheets("Shipments")
Set wb = Workbooks.Open("C:\user\12345\desktop\surcharge data.csv")
Set cws = wb.Sheets("Charges")
Set cws = Sheets("Charges")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
clr = cws.Cells(Rows.Count, 1).End(xlUp).Row
slc = sws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If slr < 2 Or clr < 2 Then
   MsgBox "Data not found!", vbCritical
   Exit Sub
End If
Set dict = CreateObject("Scripting.Dictionary")
x = sws.Range("A2:A" & slr).Value
y = cws.Range("A1").CurrentRegion.Value

For i = 1 To UBound(x, 1)
   dict.Item(x(i, 1)) = ""
Next i

For i = 2 To UBound(y, 1)
   If dict.Item(y(i, 1)) = "" Then
      dict.Item(y(i, 1)) = y(i, 10) & ";" & y(i, 11)
   Else
      dict.Item(y(i, 1)) = dict.Item(y(i, 1)) & ";" & y(i, 10) & ";" & y(i, 11)
   End If
Next i

For i = 1 To UBound(x, 1)
   z = Split(dict.Item(x(i, 1)), ";")
   If UBound(z, 1) >= 0 Then
      sws.Cells(i + 1, slc).Resize(1, UBound(z, 1) + 1).Value = z
   End If
Next i

nslc = sws.UsedRange.Columns.Count
sws.Range("A" & slr + 1).Copy
sws.Range(sws.Cells(2, slc), sws.Cells(slr, nslc)).PasteSpecial operation:=xlAdd
sws.Range(sws.Cells(2, slc), sws.Cells(slr, nslc)).NumberFormat = "#0.00"
sws.Range(sws.Cells(1, slc), sws.Cells(1, nslc)).Value = Array("Surcharge desc 1", "Surcharge Amount 1")
sws.Range(sws.Cells(1, slc), sws.Cells(1, slc + 1)).AutoFill sws.Range(sws.Cells(1, slc), sws.Cells(1, nslc)), xlFillDefault
sws.Columns.AutoFit
wb.Close False
Set dict = Nothing
End Sub

Open in new window

Check the path of the csv file and it's name on line#8.
Avatar of Euro5

ASKER

This ran great but it went out to 36 columns rather than the 5 that were actually populated.
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Euro5

ASKER

Sorry for the vague response.

It was working correctly, except that instead of having 5 surcharges, it was copying instances across the sheet. HOWEVER, when I run it now, it is working correctly, so very sorry for the confusion.
Not sure what changed, but you have been most helpful and the code is amazing.

Surcharge descr 1,  Surcharge descr 2, etc.
Avatar of Euro5

ASKER

Thank you!!
You're welcome. Glad to help.