How do I specify # of characters in this array?

[thardin]

Right now this code works perfectly to copy columns 1 and 5 from one workbook to another. However, I need to modify it so it only copies the left 8 digits of column 1(eliminating the last 2 digits) . like =LEFT(A2,8)

How would I fix this?
Thank You.

    Dim Ary As Variant
    Dim Fname As String
    Dim lr As Long
   
   lr = Cells(Rows.Count, "A").End(xlUp).row
  
   Fname = "529 A Shares Restricted Purchases violations TD " & Format(Date, "mmddyy")
   Fname2 = "529ACANCEL" & Format(Date, "mmddyy")
   With Workbooks(Fname & ".xlsx").Sheets("Sheet1").UsedRange
      Ary = Application.Index(.Value, .Worksheet.Evaluate("row(2:" & .Rows.Count & ")"), Array(1, 5))
   End With
   Workbooks(Fname2 & ".csv").ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary
  
   ActiveSheet.UsedRange.EntireColumn.AutoFit
    ActiveSheet.UsedRange.EntireRow.AutoFit

 

[bstory84]

Try This

Dim Ary As Variant
Dim Fname As String
Dim lr As Long

lr = Cells(Rows.Count, "A").End(xlUp).Row

Fname = "529 A Shares Restricted Purchases violations TD " & Format(Date, "mmddyy")
Fname2 = "529ACANCEL" & Format(Date, "mmddyy")
With Workbooks(Fname & ".xlsx").Sheets("Sheet1").UsedRange
    Ary = Application.Index(.Value, .Worksheet.Evaluate("row(2:" & .Rows.Count & ")"), Array(1, 5))
End With

'ADDED
For arrayItem = LBound(Ary) To UBound(Ary)
    Ary(arrayItem, 1) = Left(Ary(arrayItem, 1), 8)
    Ary(arrayItem, 2) = Left(Ary(arrayItem, 2), 8)
Next arrayItem
'END ADDITIONS

Workbooks(Fname2 & ".csv").ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary
Sheet2.UsedRange.EntireColumn.AutoFit
Sheet2.UsedRange.EntireRow.AutoFit

 

[thardin]

Thank you for your reply. I'll test it next week!

 

[Peter_SSs]

Right now this code works perfectly to copy columns 1 and 5 from one workbook to another.

In that case I think this slight modification should work for you (untested as I don't have your particular data, layout etc to test with)
It also may need a slight modification if you have a header in A1
From your description I also assumed the values in column A are all 10 digits to start with.
Try replacing the struck-through line with the blue code

Workbooks(Fname2 & ".csv").ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary

With Workbooks(Fname2 & ".csv").ActiveSheet.Range("A1").Resize(UBound(Ary), 2)
  .Value = Ary
  .Columns(1).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 2))
End With

Also, when posting vba code in the forum, please use the available code tags. My signature block below has more details. I have added them for you this time.

 

[thardin]

Hello, I decided to test both of your codes and neither worked.
I kept getting an error saying "can't find project or library."
is it because you didn't Dim "arrayItem"?

I came up with this code to accomplish my task, but I'm not sure if it's good.
Is there a more effective way to write this?
Thanks.

Sub Test()
Dim Ary As Variant
Dim Fname As String, Fname2 As String
Dim lr As Long
Dim Cell As Range
Dim BValue As String

lr = Cells(Rows.Count, "A").End(xlUp).row

Fname = "Book2"
Fname2 = "Book1"
With Workbooks(Fname & ".xlsx").Sheets("Sheet1").UsedRange
Ary = Application.Index(.Value, .Worksheet.Evaluate("row(2:" & .Rows.Count & ")"), Array(1, 5))
End With
Workbooks(Fname2 & ".xlsx").ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary

Workbooks(Fname2 & ".xlsx").Activate
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.UsedRange.EntireRow.AutoFit


Range("A1").EntireColumn.Insert
Range("A1") = Range("B1").Value


lr = Cells(Rows.Count, "B").End(xlUp).row

For Each Cell In Range("A1:A" & lr)
BValue = Cell.Offset(0, 1).Value
Cell.Formula = "=Left(" & BValue & ",8)"

Next Cell

Range("B1").EntireColumn.Delete

ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.UsedRange.EntireRow.AutoFit

End Sub

 

[thardin]

BTW, This is a picture of what I'm trying to do:

 

[johnnyL]

How about:

Sub TestV2()
'
    Dim Cell                As Range
    Dim FileExtention       As String
    Dim DestinationFileName As String, SourceFileName   As String
    Dim Ary                 As Variant
'
    DestinationFileName = "Book1"                                                                           ' <--- Set this to the DestinationFileName
    SourceFileName = "Book2"                                                                                ' <--- Set this to the SourceFileName
    FileExtention = ".xlsx"                                                                                 ' <--- Set this to the FileExtention of the files
'
    With Workbooks(SourceFileName & FileExtention).Sheets("Sheet1").UsedRange                               ' With SourceFileName range ...
        Ary = Application.Index(.Value, .Worksheet.Evaluate("row(2:" & .Rows.Count & ")"), Array(1, 5))     '   Load columns A and E into 2D 1 based Ary. RC
    End With
'
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary   ' Copy Ary to DestinationFileName columns A & B
'
    For Each Cell In Workbooks(DestinationFileName & FileExtention).ActiveSheet.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Cell.Formula = "=Left(" & Cell.Value & ", 8)"                                                       '   Copy formula down the column A of DestinationFile
        Cell.Value = Cell.Value                                                                             '   Remove the formulas from the column, leave values
    Next
'
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.UsedRange.EntireColumn.AutoFit               ' Autofit columns in DestinationFileName data range
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.UsedRange.EntireRow.AutoFit                  ' Autofit rows in DestinationFileName data range
End Sub

 

[thardin]

How about:

Sub TestV2()
'
    Dim Cell                As Range
    Dim FileExtention       As String
    Dim DestinationFileName As String, SourceFileName   As String
    Dim Ary                 As Variant
'
    DestinationFileName = "Book1"                                                                           ' <--- Set this to the DestinationFileName
    SourceFileName = "Book2"                                                                                ' <--- Set this to the SourceFileName
    FileExtention = ".xlsx"                                                                                 ' <--- Set this to the FileExtention of the files
'
    With Workbooks(SourceFileName & FileExtention).Sheets("Sheet1").UsedRange                               ' With SourceFileName range ...
        Ary = Application.Index(.Value, .Worksheet.Evaluate("row(2:" & .Rows.Count & ")"), Array(1, 5))     '   Load columns A and E into 2D 1 based Ary. RC
    End With
'
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.Range("A1").Resize(UBound(Ary), 2).Value = Ary   ' Copy Ary to DestinationFileName columns A & B
'
    For Each Cell In Workbooks(DestinationFileName & FileExtention).ActiveSheet.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Cell.Formula = "=Left(" & Cell.Value & ", 8)"                                                       '   Copy formula down the column A of DestinationFile
        Cell.Value = Cell.Value                                                                             '   Remove the formulas from the column, leave values
    Next
'
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.UsedRange.EntireColumn.AutoFit               ' Autofit columns in DestinationFileName data range
    Workbooks(DestinationFileName & FileExtention).ActiveSheet.UsedRange.EntireRow.AutoFit                  ' Autofit rows in DestinationFileName data range
End Sub

I made a few tweaks, but it works great! thanks

 

[johnnyL]

Glad to help @thardin.

 

[thardin]

Glad to help @thardin.

I have another Copy and paste Macro I'm having trouble with. Do you think you can take a look? Thanks.