Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 96
  • Last Modified:

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

0
Euro5
Asked:
Euro5
  • 3
  • 3
1 Solution
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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.
0
 
Euro5Author Commented:
This ran great but it went out to 36 columns rather than the 5 that were actually populated.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
I have no clue what you are talking about.
If you refer to your previous question, the cws will be the the sheet of the workbook which is being opened by the latest code.
Would you elaborate it a bit more to understand what's happening at your end?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Euro5Author Commented:
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.
0
 
Euro5Author Commented:
Thank you!!
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad to help.
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now