VBA Help - Populating an Array Based on Cell Values

[Bigwelshal]

Hi.

I have the below piece of code which is copying specified columns from a CSV file into an excel worksheet which works fine.

Sub CSV_to_XLSX_PS()

' ### 23 Apr. 2019 oAnast ###

Dim mywb As Workbook, wb As Workbook

Dim sh As Worksheet

Set mywb = ThisWorkbook

Dim vFile

Dim fn

Dim x As Integer, t As Integer

Dim v As Variant, vName As Variant, GetDirectory As Variant

v = Array(3, 5, 14, 15, 30, 113, 122, 123, 124, 133, 134) ' ## EXPORT COLUMNS ##

vFile = Application.GetOpenFilename("CSV Files(*.csv),*.csv", , "Please Select Post Change Results File", MultiSelect:=False)

If vFile = False Then Exit Sub

vName = Split(vFile, "\")

'vName = Replace(vName(UBound(v)), ".csv", "")

'GetDirectory = Left(vName, InStrRev(vName, Application.PathSeparator))

Application.ScreenUpdating = False

Sheets("CSV OUT PS").Select
Cells.Select
Range("A1").Activate
Selection.ClearContents

Dim Sheetname As String
Sheetname = "CSV OUT PS"

Set sh = mywb.Sheets(Sheetname)

'sh.Name = vName

Workbooks.OpenText Filename:=vFile, Local:=True

Set wb = ActiveWorkbook

t = 1

For x = 0 To UBound(v)

wb.Sheets(1).Columns(v(x)).Copy sh.Cells(1, t)

t = t + 1

Next

sh.UsedRange.EntireColumn.AutoFit

wb.Close False

'fn = GetDirectory & "CSV OUT Split.xlsx"

'sh.Copy

Application.DisplayAlerts = False

'ActiveWorkbook.SaveAs fn

'ActiveWorkbook.Close False

'sh.Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

What I would like to do is change this bit v = Array(3, 5, 14, 15, 30, 113, 122, 123, 124, 133, 134) to take the values from a specified range within the excel workbook. It would be handy if the range could be dynamic too as it could change in length, for example it could be H1:H10 but if more data is needed it could be H1:H200.


I hope that makes sense but please let me know if any more detail is needed.

Many thanks

AJ

 

[kevin9999]

This is the bit of code that will get you there - just change "Sheet1" to whatever sheet you want to list the column array, and to whatever sheet you want the copied columns to go.

Dim v, x As Long, t As Long

v = Sheet1.Range("H1", sh.Cells(Rows.Count, "H").End(xlUp))
t = 1
For x = 1 To UBound(v)
    wb.Sheets(1).Columns(v(x, 1)).Copy Sheet1.Cells(1, t)
    t = t + 1
Next x

 

[Bigwelshal]

Thank you, that worked a treat.

 

[kevin9999]

Thank you, that worked a treat.

Glad to help, and thanks for the feedback.