Excel VBA CSV import should be sorted to different locations

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
LVL 2
Mandy_Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

als315Commented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Mandy_Author Commented:
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
Mandy_Author Commented:
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
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Mandy_Author Commented:
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
als315Commented:
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
Mandy_Author Commented:
Thank you so much for your help
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.