Apologies for badly worded question.
I have the below table in excel:
The real file is 800 colums wide and 2800 rows deep so over 2 million combinations. more over its really difficult to manage in a database.
I need to convert the data to a database friendly format, something like:
Being honest I have no idea where to start. is there a reverse pivot in excel or an existing script to do this?
so logic, where row meets column in excel, fetch value and write all three to a database format.
any pointers?
Thanks as always
You could use this code to create a csv file that you can then import into the database of your choice. I tested it on a dataset of similar size to the one you described and it completed in about 30 seconds.
Sub tgr()
Dim arrData As Variant
Dim rIndex As Long
Dim cIndex As Long
Dim i As Long
Dim strLine As String
Dim strTemp As String
arrData = Range("A1", Cells(Cells(Rows.Count, "A").End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column)).Value
Close #1
Open "C:\Temp\ExcelData.csv" For Output As #1
Print #1, "Product,Customer,Price"
For rIndex = 2 To UBound(arrData, 1)
For cIndex = 2 To UBound(arrData, 2)
strLine = vbNullString
For i = 1 To 3
strTemp = Choose(i, arrData(rIndex, 1), arrData(1, cIndex), arrData(rIndex, cIndex))
If InStr(1, strTemp, ",", vbTextCompare) > 0 Then strTemp = """" & strTemp & """"
strLine = strLine & "," & strTemp
Next i
Print #1, Mid(strLine, 2)
Next cIndex
Next rIndex
Close #1
Erase arrData
End Sub
You can use the transpose function for this purpose.
Related
I'm trying to analyze some data from a worksheet, the first step was to find the last row, which I managed. Then I need to store the data in an array for each column to simplify further analysis.
My data looks like this:
I'm trying to store let's say the B column in an array but starting at B6:
Sub List_Rem_stock()
Dim array_Rem_Batch(1 To last_row_Rem_stock - 5) As Integer
For i = 1 To last_row_Rem_stock - 5
array_Rem_Batch(i) = Worksheets("Rem stock").Range(Bi)
Next i
Debug.Print array_Rem_Index
End Sub
last_row_Rem_stock represents the last row of the table.
Am I doing this properly?
Almost, try the code below (find explanation inside code's comments):
Option Explicit
Sub List_Rem_stock()
Dim last_row_Rem_stock As Long, i As Long
Dim array_Rem_Batch() As Long
With Worksheets("Rem stock")
last_row_Rem_stock = .Cells(.Rows.Count, "B").End(xlUp).Row ' get last row with value in colum B
ReDim array_Rem_Batch(1 To last_row_Rem_stock - 5) ' redim array size
For i = 1 To last_row_Rem_stock - 5
array_Rem_Batch(i) = .Range("B" & i).Value
Next i
End With
End Sub
You can allocate a range to an array (2D) as such:
Dim arrData as variant: arrData = Range("B1:B" & lastrow).
You can also put the array back on the spreadsheet the same way:
Range("B1:B" & lastrow) = arrData
Simple, easy and fast, without the need of iterating through data.
In your example, you would probably do it like this.
Sub List_Rem_stock()
Dim i As Long, last_row_Rem_stock As Long
Dim array_Rem_Batch As Variant
With Worksheets("Rem stock")
last_row_Rem_stock = .Cells(.Rows.Count, "B").End(xlUp).Row 'get last row in B
array_Rem_Batch = .Range("B1:B" & last_row_Rem_stock)
End With
For i = 6 To last_row_Rem_stock
Debug.Print array_Rem_Batch(i, 1)
Next i
End Sub
To note that arrays allocated this way will always start at 1, not 0.
EDIT:
I'm allocating the data starting at row 1, and not at row 6, purely for the nice 1:1 relation between array index and sheet rows. Is my prefered way, wherever the situation allows.
If array_Rem_Batch(i, 1) = Range("B" & i) Then ....
Can always allocate the data from any row you want:
array_Rem_Batch = Worksheets("Rem stock").Range("B6:B100") 'now the array has 95 rows.
In this case, array index 1, will corespond to row 6 in the sheet, and will have to manage this in the code if you need to something like this:
If array_Rem_Batch(i, 1) = Range("B" & i + 5) Then ....
I have the below loop in VBA:
For i = 1 To Range("B" & "65536").End(xlUp).Row Step 1
Companies = Range("A" & i).Value
Next i
MsgBox Companies 'Output Company Name (One time)
So above loop iterates through rows, that all have a company name in Column "A". I want to add all these company names to an array, so I can print them all out later on (after the loop)
How can I dynamically add the Companies value to an array, and use it later on?
you don't need Loop
Just try this :
Dim DirArray As Variant
DirArray = Range("A1:A5000").Value
I think something like this is what you're looking for.
Sub tgr()
'Declare variables
Dim ws As Worksheet
Dim Companies As Variant
Dim i As Long
'Always fully qualify which workbook and worksheet you're looking at
Set ws = ActiveWorkbook.ActiveSheet
'You can assing a Variant variable to the value of a range
' and it will populate the variable as an array if there
' is more than one cell in the range
'Note that I am going off of column B as shown in your original code,
' and then using Offset(, -1) to get the values of column A
Companies = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp)).Offset(, -1).Value
If IsArray(Companies) Then
'More than one company found, loop through them
For i = LBound(Companies, 1) To UBound(Companies, 1)
MsgBox "Company " & i & ":" & Chr(10) & _
Companies(i, 1)
Next i
Else
'Only one company found
MsgBox Companies
End If
End Sub
If you need an array, which is increased every time and still saves its contents, something like this should work:
Option Explicit
Public Sub TestMe()
Dim i As Long
Dim companies() As Variant
ReDim companies(0)
For i = 1 To 20
ReDim Preserve companies(UBound(companies) + 1)
companies(UBound(companies)) = Range("A" & i)
Next i
End Sub
If you need simply need to take the values to array, then the answer of #Leo R. is probably the easiest way to achieve it.
I'm trying to automate the import of data into a tool I'm building in Excel. The idea is to read the data from a .csv file either directly into an array, or read the data as a string and then parse it using spaces " " and commas "," as delimiters, followed by an array. I've gotten this far:
Public Sub ImportData()
Dim myData as String, strData() as String
Dim thisFile as String
thisFile = ActiveWorkbook.Path & "\" & "s.csv"
Open thisFile For Binary As #1
myData = Space$(LOF(1))
Get #1, , myData
Close #1
End Sub
This gets me to where "myData" is a now string of data separated by commas and spaces (commas delimiting for a new column, spaces delimiting for a new row).
How do I proceed to reconstruct this as a multidimensional (2D) array so that it can be printed onto the sheet I'm working on, or referenced straight from memory? Or is there an easier way?
This is the implementation suggested by #Tim
Option Explicit
Public Sub OpenFile()
Dim rawData As String, lineArr As Variant, cellArr As Variant
Dim ubR As Long, ubC As Long, r As Long, c As Long
Open ActiveWorkbook.Path & "\" & "s.csv" For Binary As #1
rawData = Space$(LOF(1))
Get #1, , rawData
Close #1
If Len(rawData) > 0 Then
'If spaces are delimiters for lines change vbCrLf to " "
lineArr = Split(Trim$(rawData), vbCrLf)
ubR = UBound(lineArr) + 1
ubC = UBound(Split(lineArr(0), ",")) + 1
ReDim arr(1 To ubR, 1 To ubC)
For r = 1 To ubR
If Len(lineArr(r - 1)) > 0 Then
cellArr = Split(lineArr(r - 1), ",")
For c = 1 To ubC
arr(r, c) = cellArr(c - 1)
Next
End If
Next
ActiveSheet.Range(Cells(1), Cells(ubR, ubC)) = arr 'Place array on the sheet
End If
End Sub
I have written a VB.NET application in Visual Studio 2015. (first time ever had any contact with visual basic or VS). The application takes an input csv file, analyses it and splits it according to that analysis into 2 output csv files. For one of these output files, I then need to change every blank cell to have the value of zero. My prob, is that the code i've made is processing 750 input csv files to produce 1500 output files and each process in the loop is taking 5 mins meaning it's taking up to 5 days to run!! That is too long!
I'm trying to work out how to make the code run quicker. One easy first step would be in the blank cell to zero operation as i'm currently doing it cell by cell. I read that better to do via an array but i'm unsure how to code it...Can someone help?
My code now is:
Dim forceDataRangeDest, cell As Excel.Range
Dim blank As String
Dim forceDataRow, lastDataRow As Integer
'copy force data from original workbook to sheet 1 of new workbook
If ws.Range("Z" & (forceLegRowStart + 1)).Value = "Force Plate 3" Then
forceDataRow = forceDataRow + 2
forceDataRangeSrc = ws.Range("Z" & forceDataRow & ":AK" & lastDataRow)
Else forceDataRangeSrc = ws.Range("A" & forceDataRow & ":M" & lastDataRow)
End If
wsData = wbForce.Sheets("Sheet1")
wsData.Name = "Data"
forceDataRangeDest = wsData.Range("A1")
forceDataRangeSrc.Copy(forceDataRangeDest)
'insert new column A if Force Plate 3 data is one taken for the time interval data of column A
If ws.Range("Z" & (forceLegRowStart + 1)).Value = "Force Plate 3" Then
wsData.Columns("A:A").Insert(1)
'write in the Data
forceDataRangeSrc = ws.Range("A" & forceDataRow & ":A" & lastDataRow)
forceDataRangeSrc.Copy(wsData.Range("A1"))
End If
forceDataRangeDest = wsData.Range("A1:M" & ((lastDataRow - forceDataRow) + 1))
For Each cell In forceDataRangeDest
blank = cell.Value
If String.IsNullOrWhiteSpace(blank) Then
cell.Value = 0
End If
Next
It is the For Each cell at the bottom of this sample code that i think is really increasing the process time...how would i write that as an array and then write array into excel in one go?
Many thanks for any help you can give.
You could use the Range.Find and Range.FindNext methods in VBA which would be quicker than looping through all the cells. Here's an example of the VBA code:
Sub FindEmptyCells()
Dim found As Range
Dim firstCell As String
Set found = ActiveSheet.UsedRange.Find(What:="", LookAt:=xlWhole)
firstCell = found.Address
Do While Not (found Is Nothing)
Debug.Print found.Address
Set found = ActiveSheet.UsedRange.FindNext(found)
If found.Address = firstCell Then
Exit Do
End If
Loop
End Sub
EDIT: Added the code to use OP's range object
Dim found As Range
Dim firstCell As String
Set found = forceDataRangeDest.Find(What:="", LookAt:=xlWhole)
firstCell = found.Address
Do While Not (found Is Nothing)
found.Value = 0
Set found = forceDataRangeDest.FindNext(found)
If found.Address = firstCell Then
Exit Do
End If
Loop
Im coming from a Unix world where I never had to develop something for Office with VBA, I have to do some now and Im having a hard time! Please help me! :)
So I've got 2 Excel Sheets(lets call them Sheet1 and Sheet2) and 2 forms(Form1 and Form2) to edit/add data.
In Sheet1, the first two columns are MovieId and MovieName. We dont know how many rows they will be in this columns.
Form1 controls data in Sheet1, and Form2... in Sheet2.
At Form2 initialization, I want to create a 2 Dimensional Array that will be like (MovieId1,MovieName1;MovieId2,MovieName2;...,...;MovieIdN,MovieNameN), where this data has been extracted from Sheet1, like a sort of Map in Java if you will...
It would actually be ok for me if it was like: (0,"MovieId0;MovieName0";1,"MovieId1,MovieName1";..,"..";N,"MovieIdN,MovieNameN")
I dont know how to create the array with an variable last row number, since the compiler seems to always want a constant to initialize an Array...
Please enlighten me!
Look at the Value method or Value2 property.
e.g. Range("$A$2:$B$4").Value2(1,1)
or
Range("$A$2:$B$4").Value()(1,1)
Array's lower bound start from 1.
lbound(Range("$A$2:$B$4").Value2, 1) - row element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - row element ends
lbound(Range("$A$2:$B$4").Value2, 2) - column element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - column element ends
EDIT: Code to traverse through the array
Dim myAddress As String
Dim dataArray As Variant
Dim rowStart As Long, rowEnd As Long
Dim colStart As Long, colEnd As Long
Dim rowCtr As Long
Dim colCtr As Long
myAddress = "$A$2:$B$4"
dataArray = Range(myAddress).Value2
rowStart = LBound(dataArray, 1)
rowEnd = UBound(dataArray, 1)
colStart = LBound(dataArray, 2)
colEnd = UBound(dataArray, 2)
For rowCtr = rowStart To rowEnd
For colCtr = colStart To colEnd
Debug.Print rowCtr & ":" & colCtr, vbTab & dataArray(rowCtr, colCtr)
Next
Next
EDIT2: In my example, I have assumed the address to be $A$2:$B$4.
You can prefix it with sheet name. e.g. Sheet1!$A$2:$B$4 or Sheet2!$A$2:$B$4
On a side note, array can be defined dynamic (if it is 1 dimensional).
e.g dim my1DArray() as Integer
For double dimension array, see the following code
Dim myArray
Dim dynamicRows As Integer
dynamicRows = 2
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
myArray(0, 0) = "hello"
dynamicRows = 20
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
myArray(0, 0) = "hello"
ReDim Preserve myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
Rather use the Range object, with this you can also use the UsedRange from the sheet
Sub Macro1()
Dim sheet As Worksheet
Dim range As range
Dim row As Integer
Set sheet = Worksheets("Sheet1")
Set range = sheet.UsedRange
For row = 1 To range.Rows.Count
Next row
End Sub
assuming the data starts in A1
Dim vArr as variant
vArr=worksheets("Sheet1").range("A1").resize(worksheets("Sheet1").range("A65535").end(xlup).row,2)
Do you mean:
Dim thearray() As Variant
ReDim thearray(1, range.Rows.Count)
You can also use a recordset and GetRows to return an array from a worksheet.
Slight mod to Charles' answer:
Dim vArr as variant
vArr = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
Assuming of course that there isn't any stray data in Sheet1.