I'm working on a Macro that opens a .csv file (user's choice), rearranges data and used vlookup formula to return values to Sheet 1 of Test.xlsm file that contains my Macro. I also would like to close .csv file at the end.
I keep getting propted to open file several times and not sure why.
Please help, I'm really struggling with this.
Thanks,
Lenna
Here is the code.
Private Sub CommandButton2_Click()
Dim csvFileTwo As Variant
Dim csvBookTwo As Workbook
Dim R As Long, C As Long, X As Long, Index As Long, LastRow As Long, LastCol As Long, FinalRowCount As Long
Dim DataIn As Variant, DataOut As Variant
Const ValuesStartColumn As Long = 5 '(Column E)
'opens a .csv file
csvFileTwo = Application.GetOpenFilename("Text Files (*.csv),(*.csv),,Please select CSV file to open")
If (csvFileTwo <> False) Then
Workbooks.Open csvFileTwo
Set csvBookTwo = ActiveWorkbook
End If
'rearrange data
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
FinalRowCount = Application.CountA(Columns(ValuesStartColumn).Resize(, Columns.Count - ValuesStartColumn + 1))
DataIn = Range("A1").Resize(LastRow, LastCol)
ReDim DataOut(1 To FinalRowCount, 1 To ValuesStartColumn)
Index = Index + 1
For R = 1 To LastRow
For C = 1 To UBound(DataIn, 2)
If Len(DataIn(R, C)) Then
For X = 1 To 4
DataOut(Index, X) = DataIn(R, X)
Next
DataOut(Index, 5) = DataIn(R, C)
If C > 4 Then Index = Index + 1
End If
Next
Next
Application.ScreenUpdating = False
Columns("F").Resize(, Columns.Count - ValuesStartColumn).Clear
Range("A1").Resize(UBound(DataOut), 5) = DataOut
Application.ScreenUpdating = True
'removes duplicates and sorts
Columns("A:E").Select
ActiveSheet.Range("$A$1:$E$15037").RemoveDuplicates Columns:=Array(3, 4, 5), _ 'I would like to go to the end of data and not to reference a cell
Header:=xlYes
Columns("B:B").Select
Selection.Cut
Columns("F:F").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Selection.Insert Shift:=xlToRight
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
"E2:E" & FinalRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
'Range("B" & FinalRow).Select
.SetRange Range("A1:E" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'I need to go back to .xlsm file and insert a row to place vlookup formula.
Windows("Test.xlsm").Activate 'i'm not sure this is good???
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1], csvFileTwo.csv!C4:C5,2,FALSE)" 'I need to reference .csv file that is opened.
Selection.Copy
Range("K1").Select
Selection.End(xlDown).Select 'copy formula down
Range("L" & FinalRow).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Columns("L:L").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"'format that column as date.
Range("L1").Select
ActiveCell.FormulaR1C1 = "ReportDate"
Range("A1").Select
'csvBookTwo.Close SaveChanges:=False ' or True 'i would like to close .csv file when I'm done.
End Sub
I keep getting propted to open file several times and not sure why.
Please help, I'm really struggling with this.
Thanks,
Lenna
Here is the code.
Private Sub CommandButton2_Click()
Dim csvFileTwo As Variant
Dim csvBookTwo As Workbook
Dim R As Long, C As Long, X As Long, Index As Long, LastRow As Long, LastCol As Long, FinalRowCount As Long
Dim DataIn As Variant, DataOut As Variant
Const ValuesStartColumn As Long = 5 '(Column E)
'opens a .csv file
csvFileTwo = Application.GetOpenFilename("Text Files (*.csv),(*.csv),,Please select CSV file to open")
If (csvFileTwo <> False) Then
Workbooks.Open csvFileTwo
Set csvBookTwo = ActiveWorkbook
End If
'rearrange data
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
FinalRowCount = Application.CountA(Columns(ValuesStartColumn).Resize(, Columns.Count - ValuesStartColumn + 1))
DataIn = Range("A1").Resize(LastRow, LastCol)
ReDim DataOut(1 To FinalRowCount, 1 To ValuesStartColumn)
Index = Index + 1
For R = 1 To LastRow
For C = 1 To UBound(DataIn, 2)
If Len(DataIn(R, C)) Then
For X = 1 To 4
DataOut(Index, X) = DataIn(R, X)
Next
DataOut(Index, 5) = DataIn(R, C)
If C > 4 Then Index = Index + 1
End If
Next
Next
Application.ScreenUpdating = False
Columns("F").Resize(, Columns.Count - ValuesStartColumn).Clear
Range("A1").Resize(UBound(DataOut), 5) = DataOut
Application.ScreenUpdating = True
'removes duplicates and sorts
Columns("A:E").Select
ActiveSheet.Range("$A$1:$E$15037").RemoveDuplicates Columns:=Array(3, 4, 5), _ 'I would like to go to the end of data and not to reference a cell
Header:=xlYes
Columns("B:B").Select
Selection.Cut
Columns("F:F").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Selection.Insert Shift:=xlToRight
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
"E2:E" & FinalRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
'Range("B" & FinalRow).Select
.SetRange Range("A1:E" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'I need to go back to .xlsm file and insert a row to place vlookup formula.
Windows("Test.xlsm").Activate 'i'm not sure this is good???
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1], csvFileTwo.csv!C4:C5,2,FALSE)" 'I need to reference .csv file that is opened.
Selection.Copy
Range("K1").Select
Selection.End(xlDown).Select 'copy formula down
Range("L" & FinalRow).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Columns("L:L").Select
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"'format that column as date.
Range("L1").Select
ActiveCell.FormulaR1C1 = "ReportDate"
Range("A1").Select
'csvBookTwo.Close SaveChanges:=False ' or True 'i would like to close .csv file when I'm done.
End Sub