Solved

Excel VBA CSV import should be sorted to different locations

Posted on 2014-09-15
6
244 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_
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
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!

 
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

632 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