Solved

Excel VBA CSV import should be sorted to different locations

Posted on 2014-09-15
6
236 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 500 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
Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

 
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 500 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

Industry Leaders: 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!

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

726 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