Solved

Use closed file on desktop in vba

Posted on 2016-08-17
6
65 Views
Last Modified: 2016-08-18
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
Comment
Question by:Euro5
  • 3
  • 3
6 Comments
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41759553
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
 

Author Comment

by:Euro5
ID: 41761186
This ran great but it went out to 36 columns rather than the 5 that were actually populated.
0
 
LVL 28

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 total points
ID: 41761209
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:Euro5
ID: 41761296
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
 

Author Closing Comment

by:Euro5
ID: 41761297
Thank you!!
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41761306
You're welcome. Glad to help.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now