Vba to convert csv (insert cells)

KGEORGE13

New Member
Joined
May 30, 2018
Messages
36
Hello,

I am going to be importing a CSV file into a sheet weekly and need the column to line up properly. The Comma Seperated list I am importing does not account for spaces I need for the excel sheet. I made a dummy table below. Every person is ordering a shirt, a hat, shoes, or any combination of the three. To the right is how many they are ordering. I need to run a macro to shift cells from the shirt column if they don't equal shirt, while also keeping the quantities. Basically I want the first table to turn into the 2nd table by running a VBA. The order will always be SHIRT - HAT - SHOES

[TABLE="width: 500"]
<tbody>[TR]
[TD]NAME
[/TD]
[TD]SHIRT?
[/TD]
[TD]QTY
[/TD]
[TD]HAT?
[/TD]
[TD]QTY
[/TD]
[TD]SHOES?
[/TD]
[TD]QTY
[/TD]
[/TR]
[TR]
[TD]kyle
[/TD]
[TD]Shirt
[/TD]
[TD]1
[/TD]
[TD]Shoes
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]john
[/TD]
[TD]Shoes
[/TD]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]jack
[/TD]
[TD]Shirt
[/TD]
[TD]3
[/TD]
[TD]Hat
[/TD]
[TD]1
[/TD]
[TD]Shoes
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]kevin
[/TD]
[TD]Hat
[/TD]
[TD]2
[/TD]
[TD]Shoes
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



[TABLE="width: 500"]
<tbody>[TR]
[TD]NAME
[/TD]
[TD]SHIRT?
[/TD]
[TD]QTY
[/TD]
[TD]HAT?
[/TD]
[TD]QTY?
[/TD]
[TD]SHOES?
[/TD]
[TD]QTY
[/TD]
[/TR]
[TR]
[TD]kyle
[/TD]
[TD]Shirt
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Shoes
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]john
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Shoes
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]jack
[/TD]
[TD]Shirt
[/TD]
[TD]3
[/TD]
[TD]Hat
[/TD]
[TD][/TD]
[TD]Shoes
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]kevin
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Hat
[/TD]
[TD]2
[/TD]
[TD]Shoes
[/TD]
[TD]1
[/TD]
[/TR]
</tbody>[/TABLE]


Anything Helps


THANK YOU!!!
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
So you're saying your CSV import for row 3 would be
john,shoes,5
instead of the proper format of
john,,,,,shoes,5

Correct? (I'm assuming your delimiter is comma)
 
Last edited:
Upvote 0
I give you the macro
The result will be on a sheet of the book where you have the macro.
Put the name of this sheet in this line: Set h1 = Sheets ("sheets9").
On that sheet, on line 1, put the headings of your products.
Put the book with the macro and the csv book in the same folder.
Put the name of the csv in this line: arch = "book5.csv"



You can have more products in the csv and the macro will put them in the column on the right.
Try and tell me

Code:
Sub Vba_to_convert_csv()
    '
    Application.ScreenUpdating = False
    '
    Dim l1 As Workbook, l2 As Workbook
    Dim h1 As Worksheet, h2 As Worksheet
    Dim ruta As String, arch As String
    Dim i As Long, u2 As Long, j As Long, k As Long, uc1 As Long, uc2 As Long
    '
    Set l1 = ThisWorkbook
    Set h1 = Sheets("sheets9")  'name of your sheet to put the result
    '
    ruta = l1.Path & "\"
    arch = "book5.csv"         'name of csv to import
    '
    If Dir(ruta & arch) = "" Then
        MsgBox "File does not exist"
        Exit Sub
    End If
    '
    Set l2 = Workbooks.Open(Filename:=ruta & arch)
    Set h2 = l2.Sheets(1)
    '
    h1.Rows("2:" & Rows.Count).ClearContents
    k = 2
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u2
        uc2 = h2.Cells(i, Columns.Count).End(xlToLeft).Column
        For j = 2 To uc2 Step 2
            ord = h2.Cells(i, j).Value
            qty = h2.Cells(i, j + 1).Value
            Set b = h1.Rows(1).Find(ord, lookat:=xlPart, LookIn:=xlValues)
            If Not b Is Nothing Then
                uc1 = b.Column
            Else
                uc1 = h1.Cells(1, Columns.Count).End(xlToLeft).Column + 1
                h1.Cells(1, uc1).Value = h2.Cells(i, "A").Value
                h1.Cells(1, uc1 + 1).Value = "QTY"
            End If
            '
            h1.Cells(k, "A").Value = h2.Cells(i, "A").Value
            h1.Cells(k, uc1).Value = ord
            h1.Cells(k, uc1 + 1).Value = qty
        Next
        k = k + 1
    Next
    '
    l2.Close False
    Set l1 = Nothing: Set h1 = Nothing
    Set l2 = Nothing: Set h2 = Nothing
    Application.ScreenUpdating = True
    '
    MsgBox "End"
End Sub



Let me know is you have any question.
 
Upvote 0
Hello, I was wondering if you could help with this same worksheet.

I decided to use the code below and it works pretty well. The only thing wrong is that it doesn't shift cells in the first 2 rows like I would like. Also, I get an error when trying to save if i edit anything in the first two rows.

Any suggestions??

Thank You!

Code:
Sub SHIFT_SAVE()
Dim i As Long, LastRow As Long, Rng As Range

'On Error GoTo ErrMsg

' CHECKING COLUMN K. IF VALUE = X , 4 CELLS WILL BE INSERTED AND X AND VALUE WILL SHIFT TO RIGHT

LastRowK1 = ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Row
Set Rng = Range("K1:K" & LastRowK1)
For i = Rng.Cells.Count To 2 Step -1
    With Rng.Cells(i)
        If .Value = "X" Then
           .Select
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            
        End If
    End With
Next i


' CHECKING COLUMN K. IF VALUE = Y , 2 CELLS WILL BE INSERTED AND Y AND VALUE WILL SHIFT TO RIGHT


LastRowK2 = ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Row
Set Rng = Range("K1:K" & LastRowK2)
For i = Rng.Cells.Count To 2 Step -1
    With Rng.Cells(i)
        If .Value = "Y" Then
           .Select
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           
            
        End If
    End With
Next i


' CHECKING COLUMN M. IF VALUE = X , 2 CELLS WILL BE INSERTED AND X AND VALUE WILL SHIFT TO RIGHT


LastRowM = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row
Set Rng = Range("M1:M" & LastRowM)
For i = Rng.Cells.Count To 2 Step -1
    With Rng.Cells(i)
        If .Value = "X" Then
           .Select
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           Selection.Insert SHIFT:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           
            
        End If
    End With
Next i

 'SAVE******************************************************************************************************
 
Dim NewSht As Worksheet
Dim fName1 As String

fName1 = Range("R2").Value

Application.DisplayAlerts = False
Set NewSht = ThisWorkbook.Worksheets.Add
fName = "U:\Desktop\" & fName1 & ".csv"   ' <----- PLACE DESIRED SAVE PATH BETWEEN FIRST SET OF QUOTATIONS
NewSht.SaveAs fName, xlCSV
NewSht.Delete
Application.DisplayAlerts = True


    Range("R1:Z3").Select
    Selection.Clear
    ActiveWorkbook.Save
    
 'SAVE*******************************************************************************************************
    
Range("A1").Select
    
 
  '  ActiveWorkbook.Close True
    





Exit Sub

' THIS MESSAGE WILL SHOW EVERYTIME THERE IS AN ERROR (NOT JUST WHEN NO FILE NAME IS TYPED IN
ErrMsg:
MsgBox ("You did not enter a new file name in CELL R2. Select the  sheet and run the Macro again. No copy and pasting is necessary."), , "NO FILE NAME FOUND"



End Sub
 
Upvote 0
If your macro has problems, then it does not work pretty well.
Did you try with my macro?
Try and tell me.
 
Upvote 0
The reason your macro is not working for what I'm trying to accomplish is because I need to use this continuously. The user is going to manually copy and past the csv file onto this sheet and run the macro, then resave it as a csv.
 
Upvote 0
Then I remove the part of opening the file from my macro and add the part of saving the file as csv.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top