Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Excel VBA CSV import should be sorted to different locations

Posted on 2014-09-15
6
Medium Priority
?
250 Views
Last Modified: 2014-09-16
Dear folks,
attached csv import into worksheet "import" and should be sorted as follows:
Rows with specific action values (New, Delete, WE) should be inserted at different locations, e.g. all "Delete"  occupy rows 151 to 185. "new" 2 to 150 and "we" from 186.
Could anybody of the VBA experts take a look to this issue?
appreciate for your help.

Sub csv_Import()
  Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
  Const cstrDelim As String = ";" 'Delimiter
  
  Dim importsheet As Worksheet
  Set importsheet = ActiveWorkbook.Sheets("IMPORT")
  
 
  Application.ScreenUpdating = False
  For i = importsheet.UsedRange.Rows.Count To 2 Step -1
    importsheet.Cells(i, 1).EntireRow.Delete
  Next
  Application.ScreenUpdating = True

 
  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Choose Filename"
    .InitialFileName = "c:\temp\*.csv"  'Pfad anpassen
    If .Show = -1 Then
      strFileName = .SelectedItems(1)
    End If
  End With
  
  If strFileName <> "" Then
    Application.ScreenUpdating = False
    Open strFileName For Input As #1
    arrDaten = Split(Input(LOF(1), 1), vbCrLf)
    Close #1
    For lngR = 1 To UBound(arrDaten)
      arrTmp = Split(arrDaten(lngR), cstrDelim)
      If UBound(arrTmp) > -1 Then
        With importsheet
          lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
          lngLast = Application.Max(lngLast, 2)
          .Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
            = Application.Transpose(Application.Transpose(arrTmp))
        End With
      End If
    Next lngR
  End If
  
End Sub

                                          

Open in new window

ee-example2.csv
0
Comment
Question by:Mandy_
  • 4
  • 2
6 Comments
 
LVL 40

Accepted Solution

by:
als315 earned 2000 total points
ID: 40324771
Try this code:
Sub csv_Import()
  Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
    Const cstrDelim As String = ";" 'Delimiter
  Dim r_curr(3) As Long, act As Integer 'Starting rows
  Dim importsheet As Worksheet, i As Integer
  Set importsheet = ActiveWorkbook.Sheets("IMPORT")
  r_curr(0) = 151
  r_curr(1) = 2
  r_curr(2) = 186
 
  Application.ScreenUpdating = False
  For i = importsheet.UsedRange.Rows.Count To 2 Step -1
    importsheet.Cells(i, 1).EntireRow.Delete
  Next
  Application.ScreenUpdating = True

 
  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Choose Filename"
    .InitialFileName = "c:\temp\*.csv"  'Pfad anpassen
    If .Show = -1 Then
      strFileName = .SelectedItems(1)
    End If
  End With
  
  If strFileName <> "" Then
    Application.ScreenUpdating = False
    Open strFileName For Input As #1
    arrDaten = Split(Input(LOF(1), 1), vbCr) 'In sample CR only, without LF
    Close #1
    For lngR = 0 To UBound(arrDaten)
      arrTmp = Split(arrDaten(lngR), cstrDelim)
      If UBound(arrTmp) > -1 Then
          Select Case arrTmp(9)
            Case "Delete"
                act = 0
            Case "WE"
                act = 1
            Case "New"
                act = 2
            Case "Aktion"
                act = 4
            Case Else
                MsgBox "Wrong Action", vbOKOnly
                Exit Sub
          End Select
          If act < 4 Then
            lngLast = r_curr(act)
            r_curr(act) = r_curr(act) + 1
          Else
            lngLast = 1
          End If
        With importsheet
          '.Cells(Rows.Count, 1).End(xlUp).Row + 1
          'lngLast = Application.Max(lngLast, 2)
          .Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
            = Application.Transpose(Application.Transpose(arrTmp))
        End With
      End If
    Next lngR
  End If
  
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:Mandy_
ID: 40324880
Hi ,
Thank you so much for your help. I have still 2 problems.

1. the header inserted begins with   "UserId" but the CSV is ok. Dont know why.
much more important:
2. All references with formula in other worksheet to this data are gone.  e.g.  to A2 =IMPORT!#reference!



UserId; Name; Comp; Loc, typ; IdentNr; ID; Interface; Date; Aktion; Product; Version; SMTP; SMTP2;      
S123456; jones, mike; GUL; BVS ;I;2476311 ;181062 ;er ;2013-07-12 12:03:34;Delete; Pail ;MSXC;
S123456; jones, mike; GUL; BVS ;I;2476311 ;181062 ;er ;2013-07-12 12:03:34;new; Pail ;MSXC;
S123456; jones, mike; GUL; BVS ;I;2476311 ;181062 ;er ;2013-07-12 12:03:34 ;we ;Pail ;MSXC;
0
 
LVL 2

Author Comment

by:Mandy_
ID: 40325039
If i remove the screen updating part below the ref# from other worksheet retained. The question is how could the worksheet cleaned up before the import, without losing the cell references?

Application.ScreenUpdating = False
  For i = importsheet.UsedRange.Rows.Count To 2 Step -1
    importsheet.Cells(i, 1).EntireRow.Delete
  Next
  Application.ScreenUpdating = True
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 2

Author Comment

by:Mandy_
ID: 40325064
i replaced
Application.ScreenUpdating = False
  For i = importsheet.UsedRange.Rows.Count To 2 Step -1
    importsheet.Cells(i, 1).EntireRow.Delete
  Next
  Application.ScreenUpdating = True

with
Dim rng
  Set rng = ActiveSheet.UsedRange
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
rng.ClearContents


and the #ref are all ok now. Could i use this?
0
 
LVL 40

Assisted Solution

by:als315
als315 earned 2000 total points
ID: 40326268
1. I have no problems with first line in uploaded sample. May be you can upload new csv for testing?
2. Broken references appearing when you are deleting rows. Clear content instead of delete. One line will be enough:
  importsheet.UsedRange.Clear
0
 
LVL 2

Author Closing Comment

by:Mandy_
ID: 40327288
Thank you so much for your help
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

772 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